This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[PATCH #2] Re: [perl #22181] goto undefines my() variables
authorDave Mitchell <davem@fdisolutions.com>
Thu, 22 May 2003 10:13:19 +0000 (11:13 +0100)
committerJarkko Hietaniemi <jhi@iki.fi>
Sat, 24 May 2003 06:42:52 +0000 (06:42 +0000)
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 <davem@fdgroup.com>
Date: Fri, 23 May 2003 17:09:44 +0100
Message-ID: <20030523160944.GC9194@fdgroup.com>

p4raw-id: //depot/perl@19610

ext/B/B/Concise.pm
ext/B/B/Deparse.pm
ext/B/t/debug.t
ext/B/t/deparse.t
op.c
op.h
t/op/goto.t
t/run/switchd.t

index 5dc3332..3611626 100644 (file)
@@ -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",
index b700650..6e48335 100644 (file)
@@ -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;
            }
        }
index 286dac3..151a5f3 100755 (executable)
@@ -54,13 +54,13 @@ if ($is_thread) {
     $b=<<EOF;
 leave enter nextstate label leaveloop enterloop null and defined null
 threadsv readline gv lineseq nextstate aassign null pushmark split pushre
-threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
+threadsv const null pushmark rvav gv nextstate subst const unstack
 EOF
 } else {
     $b=<<EOF;
 leave enter nextstate label leaveloop enterloop null and defined null
 null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
-null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
+null gvsv const null pushmark rvav gv nextstate subst const unstack
 EOF
 }
 $b=~s/\n/ /g;$b=~s/\s+/ /g;
index f60d913..a3c2bec 100644 (file)
@@ -15,7 +15,7 @@ use warnings;
 use strict;
 use Config;
 
-print "1..18\n";
+print "1..31\n";
 
 use B::Deparse;
 my $deparse = B::Deparse->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 (file)
--- 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 (file)
--- a/op.h
+++ b/op.h
@@ -159,7 +159,7 @@ Deprecated.  Use C<GIMME_V> 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 */
index 5b30dc5..8a39d9a 100755 (executable)
@@ -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:
index 91efbef..160ea99 100644 (file)
@@ -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);
 }