From: Dave Mitchell Date: Thu, 22 May 2003 10:13:19 +0000 (+0100) Subject: [PATCH #2] Re: [perl #22181] goto undefines my() variables X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=241416b843acd61d654907e145e85fc482a50be6;p=p5sagit%2Fp5-mst-13.2.git [PATCH #2] Re: [perl #22181] goto undefines my() variables Date: Thu, 22 May 2003 10:13:19 +0100 Message-ID: <20030522091319.GA4568@fdgroup.com> Subject: Re: [PATCH #2] Re: [perl #22181] goto undefines my() variables From: Dave Mitchell Date: Fri, 23 May 2003 17:09:44 +0100 Message-ID: <20030523160944.GC9194@fdgroup.com> p4raw-id: //depot/perl@19610 --- diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 5dc3332..3611626 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -326,7 +326,7 @@ my %priv; $priv{$_}{128} = "LVINTRO" for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv", "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv", - "padav", "padhv"); + "padav", "padhv", "enteriter"); $priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite"); $priv{"aassign"}{64} = "COMMON"; $priv{"sassign"}{64} = "BKWARD"; @@ -342,7 +342,8 @@ $priv{"entersub"}{32} = "TARG"; @{$priv{$_}}{4,8,128} = ("INARGS","AMPER","NO()") for ("entersub", "rv2cv"); $priv{"gv"}{32} = "EARLYCV"; $priv{"aelem"}{16} = $priv{"helem"}{16} = "LVDEFER"; -$priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv"); +$priv{$_}{16} = "OURINTR" for ("gvsv", "rv2sv", "rv2av", "rv2hv", "r2gv", + "enteriter"); $priv{$_}{16} = "TARGMY" for (map(($_,"s$_"),"chop", "chomp"), map(($_,"i_$_"), "postinc", "postdec", "multiply", "divide", "modulo", diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index b700650..6e48335 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -2323,7 +2323,7 @@ sub loop_common { my $body; my $cond = undef; if ($kid->name eq "lineseq") { # bare or infinite loop - if (is_state $kid->last) { # infinite + if ($kid->last->name eq "unstack") { # infinite $head = "while (1) "; # Can't use for(;;) if there's a continue $cond = ""; } else { @@ -2346,17 +2346,14 @@ sub loop_common { $var = $self->pp_threadsv($enter, 1); } else { # regular my() variable $var = $self->pp_padsv($enter, 1); - if ($self->padname_sv($enter->targ)->IVX == - $kid->first->first->sibling->last->cop_seq) - { - # If the scope of this variable closes at the last - # statement of the loop, it must have been - # declared here. - $var = "my " . $var; - } } } elsif ($var->name eq "rv2gv") { $var = $self->pp_rv2sv($var, 1); + if ($enter->private & OPpOUR_INTRO) { + # our declarations don't have package names + $var =~ s/^(.).*::/$1/; + $var = "our $var"; + } } elsif ($var->name eq "gv") { $var = "\$" . $self->deparse($var, 1); } @@ -2372,18 +2369,18 @@ sub loop_common { return "{;}"; # {} could be a hashref } # If there isn't a continue block, then the next pointer for the loop - # will point to the unstack, which is kid's penultimate child, except + # will point to the unstack, which is kid's last child, except # in a bare loop, when it will point to the leaveloop. When neither of - # these conditions hold, then the third-to-last child in the continue + # these conditions hold, then the second-to-last child is the continue # block (or the last in a bare loop). my $cont_start = $enter->nextop; my $cont; - if ($$cont_start != $$op && ${$cont_start->sibling} != ${$body->last}) { + if ($$cont_start != $$op && ${$cont_start} != ${$body->last}) { if ($bare) { $cont = $body->last; } else { $cont = $body->first; - while (!null($cont->sibling->sibling->sibling)) { + while (!null($cont->sibling->sibling)) { $cont = $cont->sibling; } } diff --git a/ext/B/t/debug.t b/ext/B/t/debug.t index 286dac3..151a5f3 100755 --- a/ext/B/t/debug.t +++ b/ext/B/t/debug.t @@ -54,13 +54,13 @@ if ($is_thread) { $b=<new() or print "not "; @@ -196,3 +196,70 @@ my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ"; #### # 15 s/x/'y';/e; +#### +# 16 - various lypes of loop +{ my $x; } +#### +# 17 +while (1) { my $k; } +#### +# 18 +my ($x,@a); +$x=1 for @a; +>>>> +my($x, @a); +foreach $_ (@a) { + $x = 1; +} +#### +# 19 +for (my $i = 0; $i < 2;) { + my $z = 1; +} +#### +# 20 +for (my $i = 0; $i < 2; ++$i) { + my $z = 1; +} +#### +# 21 +for (my $i = 0; $i < 2; ++$i) { + my $z = 1; +} +#### +# 22 +my $i; +while ($i) { my $z = 1; } continue { $i = 99; } +#### +# 23 +foreach $i (1, 2) { + my $z = 1; +} +#### +# 24 +my $i; +foreach $i (1, 2) { + my $z = 1; +} +#### +# 25 +my $i; +foreach my $i (1, 2) { + my $z = 1; +} +#### +# 26 +foreach my $i (1, 2) { + my $z = 1; +} +#### +# 27 +foreach our $i (1, 2) { + my $z = 1; +} +#### +# 28 +my $i; +foreach our $i (1, 2) { + my $z = 1; +} diff --git a/op.c b/op.c index f3e616f..80a0e9b 100644 --- a/op.c +++ b/op.c @@ -3618,11 +3618,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP * if (!next) next = unstack; cont = append_elem(OP_LINESEQ, cont, unstack); - if ((line_t)whileline != NOLINE) { - PL_copline = (line_t)whileline; - cont = append_elem(OP_LINESEQ, cont, - newSTATEOP(0, Nullch, Nullop)); - } } listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont); @@ -3675,13 +3670,16 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo OP *wop; PADOFFSET padoff = 0; I32 iterflags = 0; + I32 iterpflags = 0; if (sv) { if (sv->op_type == OP_RV2SV) { /* symbol table variable */ + iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */ sv->op_type = OP_RV2GV; sv->op_ppaddr = PL_ppaddr[OP_RV2GV]; } else if (sv->op_type == OP_PADSV) { /* private variable */ + iterpflags = sv->op_private & OPpLVAL_INTRO; /* for my $x () */ padoff = sv->op_targ; sv->op_targ = 0; op_free(sv); @@ -3740,6 +3738,9 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo loop = (LOOP*)list(convert(OP_ENTERITER, iterflags, append_elem(OP_LIST, expr, scalar(sv)))); assert(!loop->op_next); + /* for my $x () sets OPpLVAL_INTRO; + * for our $x () sets OPpOUR_INTRO; both only used by Deparse.pm */ + loop->op_private = iterpflags; #ifdef PL_OP_SLAB_ALLOC { LOOP *tmp; diff --git a/op.h b/op.h index cfc5e2b..3bf90c7 100644 --- a/op.h +++ b/op.h @@ -159,7 +159,7 @@ Deprecated. Use C instead. #define OPpEARLY_CV 32 /* foo() called before sub foo was parsed */ /* OP_?ELEM only */ #define OPpLVAL_DEFER 16 /* Defer creation of array/hash elem */ - /* OP_RV2?V, OP_GVSV only */ + /* OP_RV2?V, OP_GVSV, OP_ENTERITER only */ #define OPpOUR_INTRO 16 /* Variable was in an our() */ /* OP_RV2[AH]V, OP_PAD[AH]V, OP_[AH]ELEM */ #define OPpMAYBE_LVSUB 8 /* We might be an lvalue to return */ diff --git a/t/op/goto.t b/t/op/goto.t index 5b30dc5..8a39d9a 100755 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -2,7 +2,7 @@ # "This IS structured code. It's just randomly structured." -print "1..28\n"; +print "1..29\n"; while ($?) { $foo = 1; @@ -185,6 +185,17 @@ sub f1 { } f1(); +# bug #22181 - this used to coredump or make $x undefined, due to +# erroneous popping of the inner BLOCK context + +for ($i=0; $i<2; $i++) { + my $x = 1; + goto LABEL29; + LABEL29: + print "not " if !defined $x || $x != 1; +} +print "ok 29 - goto in for(;;) with continuation\n"; + exit; bypass: diff --git a/t/run/switchd.t b/t/run/switchd.t index 91efbef..160ea99 100644 --- a/t/run/switchd.t +++ b/t/run/switchd.t @@ -35,6 +35,6 @@ __SWDTEST__ switches => [ '-Ilib', '-d:switchd' ], progfile => $filename, ); - like($r, qr/^main,swdtest.tmp,9;Foo,swdtest.tmp,5;Foo,swdtest.tmp,6;Foo,swdtest.tmp,6;Bar,swdtest.tmp,2;Foo,swdtest.tmp,6;Bar,swdtest.tmp,2;Foo,swdtest.tmp,6;Bar,swdtest.tmp,2;Foo,swdtest.tmp,6;$/i); + like($r, qr/^main,swdtest.tmp,9;Foo,swdtest.tmp,5;Foo,swdtest.tmp,6;Foo,swdtest.tmp,6;Bar,swdtest.tmp,2;Bar,swdtest.tmp,2;Bar,swdtest.tmp,2;$/i); }