develooper Front page | perl.perl5.porters | Postings from February 2000

Re: [ID 20000225.005] My variable defined at start of cycle

Thread Previous
From:
Gurusamy Sarathy
Date:
February 25, 2000 11:27
Subject:
Re: [ID 20000225.005] My variable defined at start of cycle
Message ID:
200002251930.LAA24412@maul.activestate.com
On Fri, 25 Feb 2000 15:01:33 +0100, Jan Pazdziora wrote:
>Andreas Koenig pointed out that there is a problem with my DBD::XBase
>module under bleeding edge perl. I've localized the problem and stripped
>it to minimal code that still shows the behaviour, which is (I hope I'm
>not terribly overlooking something) a bug in perl itself.
>
>        while (1) {
>                my $error;
>
>                die "Fault!\n" if defined $error;
>
>                $error = 1;
>
>                if (1) {
>                        next;
>                }
>        }
>        continue {
>        }
>__END__
>
>This code prints with Fault! when run on 5.5.660 grabbed from CPAN.

Great test case.  Here's the fix.


Sarathy
gsar@ActiveState.com
-----------------------------------8<-----------------------------------
Change 5255 by gsar@auger on 2000/02/25 19:23:58

	change#4849 wasn't restoring savestack correctly; make loops that have
	continue blocks recognizable at run time

Affected files ...

... //depot/perl/op.c#265 edit
... //depot/perl/op.h#52 edit
... //depot/perl/pp_ctl.c#185 edit
... //depot/perl/t/cmd/while.t#10 edit

Differences ...

==== //depot/perl/op.c#265 (text) ====
Index: perl/op.c
--- perl/op.c.~1~	Fri Feb 25 11:24:02 2000
+++ perl/op.c	Fri Feb 25 11:24:02 2000
@@ -3764,6 +3764,7 @@
     OP *listop;
     OP *o;
     OP *condop;
+    U8 loopflags = 0;
 
     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
 		 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
@@ -3796,8 +3797,10 @@
 	block = scope(block);
     }
 
-    if (cont)
+    if (cont) {
 	next = LINKLIST(cont);
+	loopflags |= OPpLOOP_CONTINUE;
+    }
     if (expr) {
 	cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
 	if ((line_t)whileline != NOLINE) {
@@ -3840,6 +3843,7 @@
 
     loop->op_redoop = redo;
     loop->op_lastop = o;
+    o->op_private |= loopflags;
 
     if (next)
 	loop->op_nextop = next;

==== //depot/perl/op.h#52 (text) ====
Index: perl/op.h
--- perl/op.h.~1~	Fri Feb 25 11:24:02 2000
+++ perl/op.h	Fri Feb 25 11:24:02 2000
@@ -139,6 +139,9 @@
 /* Private for OP_REPEAT */
 #define OPpREPEAT_DOLIST	64	/* List replication. */
 
+/* Private for OP_LEAVELOOP */
+#define OPpLOOP_CONTINUE	64	/* a continue block is present */
+
 /* Private for OP_RV2?V, OP_?ELEM */
 #define OPpDEREF		(32|64)	/* Want ref to something: */
 #define OPpDEREF_AV		32	/*   Want ref to AV. */

==== //depot/perl/pp_ctl.c#185 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c.~1~	Fri Feb 25 11:24:02 2000
+++ perl/pp_ctl.c	Fri Feb 25 11:24:02 2000
@@ -1983,17 +1983,14 @@
     if (cxix < cxstack_ix)
 	dounwind(cxix);
 
-    cx = &cxstack[cxstack_ix];
-    {
-	OP *nextop = cx->blk_loop.next_op;
-	/* clean scope, but only if there's no continue block */
-	if (nextop == cUNOPx(cx->blk_loop.last_op)->op_first->op_next) {
-	    TOPBLOCK(cx);
-	    oldsave = PL_scopestack[PL_scopestack_ix - 1];
-	    LEAVE_SCOPE(oldsave);
-	}
-	return nextop;
+    TOPBLOCK(cx);
+
+    /* clean scope, but only if there's no continue block */
+    if (!(cx->blk_loop.last_op->op_private & OPpLOOP_CONTINUE)) {
+	oldsave = PL_scopestack[PL_scopestack_ix - 1];
+	LEAVE_SCOPE(oldsave);
     }
+    return cx->blk_loop.next_op;
 }
 
 PP(pp_redo)

==== //depot/perl/t/cmd/while.t#10 (xtext) ====
Index: perl/t/cmd/while.t
--- perl/t/cmd/while.t.~1~	Fri Feb 25 11:24:02 2000
+++ perl/t/cmd/while.t	Fri Feb 25 11:24:02 2000
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..19\n";
+print "1..22\n";
 
 open (tmp,'>Cmd_while.tmp') || die "Can't create Cmd_while.tmp.";
 print tmp "tvi925\n";
@@ -160,3 +160,20 @@
         print "ok $l\n"
     }
 }
+
+$i = 20;
+{
+    while (1) {
+	my $x;
+	print $x if defined $x;
+	$x = "not ";
+	print "ok $i\n"; ++$i;
+	if ($i == 21) {
+	    next;
+	}
+	last;
+    }
+    continue {
+        print "ok $i\n"; ++$i;
+    }
+}
End of Patch.

Thread Previous


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About