Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.96k stars 555 forks source link

goto undefines my() variables #6503

Closed p5pRT closed 21 years ago

p5pRT commented 21 years ago

Migrated from rt.perl.org#22181 (status was 'resolved')

Searchable as RT22181$

p5pRT commented 21 years ago

From ilya.sandler@na.teleatlas.com

The following one-liner illustrates the problem

perl -we ' for($i=0; $i\< 4; $i++) { my $x=2; goto bar; bar​: print $x}'

It produces​: Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1.

Instead of expected "2222"

A bug? Or am I missing something?

Thanks for your attention

Ilya

Perl Info ``` Flags: category=core severity=medium Site configuration information for perl v5.6.1: Configured by bhcompile at Mon Apr 1 12:22:19 EST 2002. Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration: Platform: osname=linux, osvers=2.4.17-0.13smp, archname=i386-linux uname='linux daffy.perf.redhat.com 2.4.17-0.13smp #1 smp fri feb 1 10:30:48 est 2002 i686 unknown ' config_args='-des -Doptimize=-O2 -march=i386 -mcpu=i686 -Dcc=gcc -Dcf_by=Red Hat, Inc. -Dcccdlflags=-fPIC -Dinstallprefix=/usr -Dprefix=/usr -Darchname=i386-linux -Dvendorprefix=/usr -Dsiteprefix=/usr -Uusethreads -Uuseithreads -Uuselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db -Di_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=undef d_sfio=undef uselargefiles=undef usesocks=undef use64bitint=undef use64bitall=undef uselongdouble=undef Compiler: cc='gcc', ccflags ='-fno-strict-aliasing -I/usr/local/include', optimize='-O2 -march=i386 -mcpu=i686', cppflags='-fno-strict-aliasing -I/usr/local/include' ccversion='', gccversion='2.96 20000731 (Red Hat Linux 7.2 2.96-109)', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4 alignbytes=4, usemymalloc=n, prototype=define Linker and Libraries: ld='gcc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lnsl -ldl -lm -lc -lcrypt -lutil perllibs=-lnsl -ldl -lm -lc -lcrypt -lutil libc=/lib/libc-2.2.5.so, so=so, useshrplib=false, libperl=libperl.a Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic' cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib' Locally applied patches: @INC for perl v5.6.1: /usr/lib/perl5/5.6.1/i386-linux /usr/lib/perl5/5.6.1 /usr/lib/perl5/site_perl/5.6.1/i386-linux /usr/lib/perl5/site_perl/5.6.1 /usr/lib/perl5/site_perl/5.6.0 /usr/lib/perl5/site_perl /usr/lib/perl5/vendor_perl/5.6.1/i386-linux /usr/lib/perl5/vendor_perl/5.6.1 /usr/lib/perl5/vendor_perl . Environment for perl v5.6.1: HOME=/home/sandler LANG=en_US.iso885915 LANGUAGE (unset) LC_CTYPE=iso_8859_1 LD_LIBRARY_PATH= LOGDIR (unset) PATH=/vol/durham/coresoft/sol/j2se/bin:/home/sandler/bin:/usr/openwin/bin:/usr/bin:/site/tools/gnu/bin:/usr/ccs/bin:/site/tools/util/bin:/usr/ucb:/bin:/usr/sccs:/usr/local/bin:/site/tools/local/bin:/site/tools/com/bin:/vol/local/bin:/usr/dt/bin:/usr/sbin:.:/home/sandler/s/hybrid/poi/bin:/home/sandler/tools:/home/sandler/s/kiwi/tools:/home/sandler/s/javamap/jtools PERL_BADLANG=0 SHELL=/site/tools/util/bin/tcsh ```
p5pRT commented 21 years ago

From dankogai@dan.co.jp

On Tuesday\, May 13\, 2003\, at 04​:56 AM\, Ilya Sandler (via RT) wrote​:

perl -we ' for($i=0; $i\< 4; $i++) { my $x=2; goto bar; bar​: print $x}'

It produces​: Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1.

Instead of expected "2222"

A bug? Or am I missing something?

Here is what perldoc -f goto says;

The "goto-LABEL" form finds the statement labeled with LABEL and resumes execution there. It may not be used to go into any construct that requires initialization\, such as a subroutine or a "foreach" loop. It also can't be used to go into a construct that is optimized away\, or to get out of a block or subroutine given to "sort".

So the behavior is somewhat correct.

But the story does not end here. I tried running on perl 5.8.0 and bleedperl and wow! this not only reproduces uninitialized warnings but also causes segfault. Tested both on FreeBSD-4-Stable and MacOS X v10.2.6.

Since it compiles even with use strict and use warnings\, it is not supposed to segfault.

Dan the Perl5 Porter Who never used goto label for years

P.S. Should we consider use strict "goto" suand use warnings "goto" which successfully caches scripts like this?

p5pRT commented 21 years ago

From @rgs

Dan Kogai wrote​:

On Tuesday\, May 13\, 2003\, at 04​:56 AM\, Ilya Sandler (via RT) wrote​:

perl -we ' for($i=0; $i\< 4; $i++) { my $x=2; goto bar; bar​: print $x}'

It produces​: Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1.

Instead of expected "2222"

A bug? Or am I missing something?

Here is what perldoc -f goto says;

The "goto-LABEL" form finds the statement labeled with LABEL and resumes execution there. It may not be used to go into any construct that requires initialization\, such as a subroutine or a "foreach" loop. It also can't be used to go into a construct that is optimized away\, or to get out of a block or subroutine given to "sort".

But the goto\, here\, isn't used to jump inside the for loop\, since the loop is already executing.

The coredump apparently happens at loop exit.

So the behavior is somewhat correct.

But the story does not end here. I tried running on perl 5.8.0 and bleedperl and wow! this not only reproduces uninitialized warnings but also causes segfault. Tested both on FreeBSD-4-Stable and MacOS X v10.2.6.

I'd be interested in what says Andreas' binsearchaperl here.

p5pRT commented 21 years ago

From @nwc10

On Tue\, May 13\, 2003 at 12​:29​:54AM +0200\, Rafael Garcia-Suarez wrote​:

But the goto\, here\, isn't used to jump inside the for loop\, since the loop is already executing.

That's what I was going to write

The coredump apparently happens at loop exit.

That's in agreement with what I find with valgrind (not sure if you found that from valgrind)​:

$ valgrind ./perl -we ' for($i=0; $i\< 4; $i++) { my $x=2; goto bar; bar​: print $x}' ==30394== Memcheck\, a.k.a. Valgrind\, a memory error detector for x86-linux. ==30394== Copyright (C) 2002\, and GNU GPL'd\, by Julian Seward. ==30394== Using valgrind-1.9.5\, a program instrumentation system for x86-linux. ==30394== Copyright (C) 2000-2002\, and GNU GPL'd\, by Julian Seward. ==30394== Estimated CPU clock rate is 1531 MHz ==30394== For more details\, rerun with​: -v ==30394== Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1. Use of uninitialized value in print at -e line 1. ==30394== Invalid write of size 4 ==30394== at 0x80FD226​: Perl_pp_leaveloop (pp_ctl.c​:1848) ==30394== by 0x80AF5DC​: Perl_runops_debug (dump.c​:1430) ==30394== by 0x80624EA​: S_run_body (perl.c​:1582) ==30394== by 0x8062081​: perl_run (perl.c​:1501) ==30394== Address 0xEFC4890C is not stack'd\, malloc'd or free'd Segmentation fault

#2 0x080fd226 in Perl_pp_leaveloop () at pp_ctl.c​:1848 1848 *++newsp = sv_mortalcopy(*SP); (gdb) print sp $1 = (SV **) 0x4115da60 (gdb) print *sp $2 = (SV *) 0x816c850 (gdb) print **sp $3 = {sv_any = 0x4115cd84\, sv_refcnt = 2147483647\, sv_flags = 109445126} (gdb) print newsp $4 = (SV **) 0xefc4890c (gdb) print *newsp Cannot access memory at address 0xefc4890c

I'd be interested in what says Andreas' binsearchaperl here.

\

Nicholas Clark

p5pRT commented 21 years ago

From enache@rdslink.ro

On Tue\, May 13\, 2003 at 12​:29​:54AM +0200\, Rafael Garcia-Suarez wrote​:

perl -we ' for($i=0; $i\< 4; $i++) { my $x=2; goto bar; bar​: print $x}' ... I'd be interested in what says Andreas' binsearchaperl here.

Don't expect anything interesting - it will probably dump core in all versions :)

Notice also that changing 'for($i=0; $i\< 4; $i++)' to 'for($i=0; $i++\< 4;)' cures it.

Regards\, Adi

p5pRT commented 21 years ago

From enache@rdslink.ro

On Tue\, May 13\, 2003 at 02​:15​:11AM +0300\, I wrote​:

On Tue\, May 13\, 2003 at 12​:29​:54AM +0200\, Rafael Garcia-Suarez wrote​:

perl -we ' for($i=0; $i\< 4; $i++) { my $x=2; goto bar; bar​: print $x}' ... I'd be interested in what says Andreas' binsearchaperl here.

Don't expect anything interesting - it will probably dump core in all versions :)

Versions before the 0xabababab poisoning was introduced won't dump core\, but I think this is irrelevant ..

Regards\, Adi

p5pRT commented 21 years ago

From @iabyn

Funnily enough I am currrently already working on fixing an identitical bug report\, so I suggest people don't waste their time trying to diagnose it again.

It's to do with goto's use of saved COPs\, and the fact that ENTER/LEAVE isn't always preceeded by a NEXTSTATE\, leading context stack corruption. I already have a fix\, but I'm not yet happy with it and am trying to improve it.

Dave M.

-- Fire extinguisher (n) a device for holding open fire doors.

p5pRT commented 21 years ago

From enache@rdslink.ro

On Tue\, May 13\, 2003 at 01​:15​:47AM +0100\, Dave Mitchell wrote​:

It's to do with goto's use of saved COPs\, and the fact that ENTER/LEAVE isn't always preceeded by a NEXTSTATE\, leading context stack corruption. I already have a fix\, but I'm not yet happy with it and am trying to improve it.

Does your fix put a nextstate there ?

I just managed myself to avoid the erroneus popping of that frame at pp_ctl.c​:2464-2473\, without putting an extra nextstate\, but if you have a better solution ...

Regards\, Adi

p5pRT commented 21 years ago

From @iabyn

On Tue\, May 13\, 2003 at 03​:49​:43AM +0300\, Enache Adrian wrote​:

On Tue\, May 13\, 2003 at 01​:15​:47AM +0100\, Dave Mitchell wrote​:

It's to do with goto's use of saved COPs\, and the fact that ENTER/LEAVE isn't always preceeded by a NEXTSTATE\, leading context stack corruption. I already have a fix\, but I'm not yet happy with it and am trying to improve it.

Does your fix put a nextstate there ?

No\, but it adds an extra field to the context block struct\, which is why I don't like it.

I just managed myself to avoid the erroneus popping of that frame at pp_ctl.c​:2464-2473\, without putting an extra nextstate\, but if you have a better solution ...

My current approach is trying to eliminate the extra nextstate appended to the cont block (after the leave/unstack)\, which confuses goto. I'm currently enaging in Perl archaeology to see what the

  cont = append_elem(OP_LINESEQ\, cont\,   newSTATEOP(0\, Nullch\, Nullop));

is for at op.c​:3853\, that was added between perl5.003_22 and perl5.004_05.

(Oh for a repository browser that was both up-to-date and had the full history....)

[The main effect of that extra nextstate\, other than to break goto\, seems to be stop line numbering reporting correctly​:

  #!/usr/bin/perl -w

  while ($x \< 10 && $i++\<2 )   { print "loop​: $x\n"; }   continue { print "cont​: $x\n"; }

The second time round the loop the line numbers are wrong​:

$ perl5.8.0 /tmp/p Name "main​::i" used only once​: possible typo at /tmp/p line 3. Use of uninitialized value in numeric lt (\<) at /tmp/p line 3. Use of uninitialized value in concatenation (.) or string at /tmp/p line 4. loop​: Use of uninitialized value in concatenation (.) or string at /tmp/p line 5. cont​: Use of uninitialized value in numeric lt (\<) at /tmp/p line 3. Use of uninitialized value in concatenation (.) or string at /tmp/p line 3. \<= XXXX loop​: Use of uninitialized value in concatenation (.) or string at /tmp/p line 3. \<= XXX cont​: Use of uninitialized value in numeric lt (\<) at /tmp/p line 3. [davem@​percy 19435]$

]

-- Blaming Islam for 911 is like blaming Christianity for Oklahoma City.

p5pRT commented 21 years ago

From enache@rdslink.ro

On Tue\, May 13\, 2003 at 02​:34​:39AM +0100\, Dave Mitchell wrote​:

My current approach is trying to eliminate the extra nextstate appended to the cont block (after the leave/unstack)\, which confuses goto. I'm currently enaging in Perl archaeology to see what the

cont = append\_elem\(OP\_LINESEQ\, cont\,
           newSTATEOP\(0\, Nullch\, Nullop\)\);

is for at op.c​:3853\, that was added between perl5.003_22 and perl5.004_05.

I downloaded a patchfile called 128.gz some time ago ( don't remember the site :) ) and there is​:

+ Title​: "Fix line number of warnings in while() conditional"\, "misleading + uninit value warning" + From​: Chip Salzenberg \chip@&#8203;rio\.atlantic\.net\, Greg Bacon + \gbacon@&#8203;crp\-201\.adtran\.com + Msg-ID​: \199708271607\.LAA01403@&#8203;crp\-201\.adtran\.com + Files​: proto.h op.c perly.c perly.y ... - if (expr) + if (expr) {   cont = append_elem(OP_LINESEQ\, cont\, newOP(OP_UNSTACK\, 0)); + if ((line_t)whileline != NOLINE) { + copline = whileline; + cont = append_elem(OP_LINESEQ\, cont\, + newSTATEOP(0\, Nullch\, Nullop)); + } + }

Hoping this helps\, Adi

p5pRT commented 21 years ago

From ilya.sandler@na.teleatlas.com

Hi\, Dan\,

Thanks for a quick answer! I do somewhat disagree with your interpretation of perl documentation​:

Here is what perldoc -f goto says;

The "goto-LABEL" form finds the statement labeled with LABEL and resumes execution there. It may not be used to go into any construct that requires initialization\, such as a subroutine or a "foreach" loop. It also can't be used to go into a construct that is optimized away\, or to get out of a block or subroutine given to "sort".

So the behavior is somewhat correct.

Well\, but my code

for($i=0; $i\< 4; $i++) {   my $x=2;   goto bar;   bar​: print $x }

is not jumping into any construct! It's jumping within a block! I've always read "jumping into block" to mean something like this

  goto bar;   for($i=0; $i\<4;$i++) {   my $x=9; bar​:   print $x;   }

So\, even apart from the crash with perl 5.8\, the behaviour seems inconsistent with documentation (and highly unexpected)

Or was i wrong in my interpretation of "jumping into"?

Thanks\, Ilya

But the story does not end here. I tried running on perl 5.8.0 and bleedperl and wow! this not only reproduces uninitialized warnings but also causes segfault. Tested both on FreeBSD-4-Stable and MacOS X v10.2.6.

Since it compiles even with use strict and use warnings\, it is not supposed to segfault.

Dan the Perl5 Porter Who never used goto label for years

P.S. Should we consider use strict "goto" suand use warnings "goto" which successfully caches scripts like this?

p5pRT commented 21 years ago

From @iabyn

On Tue\, May 13\, 2003 at 06​:19​:18AM +0300\, Enache Adrian wrote​:

On Tue\, May 13\, 2003 at 02​:34​:39AM +0100\, Dave Mitchell wrote​:

My current approach is trying to eliminate the extra nextstate appended to the cont block (after the leave/unstack)\, which confuses goto. I'm currently enaging in Perl archaeology to see what the

cont = append\_elem\(OP\_LINESEQ\, cont\,
           newSTATEOP\(0\, Nullch\, Nullop\)\);

is for at op.c​:3853\, that was added between perl5.003_22 and perl5.004_05.

I downloaded a patchfile called 128.gz some time ago ( don't remember the site :) ) and there is​:

+ Title​: "Fix line number of warnings in while() conditional"\, "misleading + uninit value warning" + From​: Chip Salzenberg \chip@&#8203;rio\.atlantic\.net\, Greg Bacon + \gbacon@&#8203;crp\-201\.adtran\.com + Msg-ID​: \199708271607\.LAA01403@&#8203;crp\-201\.adtran\.com + Files​: proto.h op.c perly.c perly.y ... - if (expr) + if (expr) { cont = append_elem(OP_LINESEQ\, cont\, newOP(OP_UNSTACK\, 0)); + if ((line_t)whileline != NOLINE) { + copline = whileline; + cont = append_elem(OP_LINESEQ\, cont\, + newSTATEOP(0\, Nullch\, Nullop)); + } + }

Okay\, the extra nextsate which that patch adds after the unstack in the continue block\, was originally there to fix line number reporting. However\, with the more recent action of Perl_warner() of looking for COPs closer to PL_op than PL_curcop before reporting the line number\, this nextstate (a) isn't needed\, (b) actually breaks reporting the correct line number\, and of course\, (c) it has always broken goto.

It's too difficult to remove this nextstate altogether because Deparse.pm relies on it; so instead my patch optimises it away later in Perl_peep(). This patch also adds a few tests to deparse.t for various types of control loop (which I was breaking in many and varied ways during the development of this patch).

Adi - you said you also had a fix for this bug - if your approach is as clean/cleaner\, please feel free to submit it too!

Dave.

-- Any [programming] language that doesn't occasionally surprise the novice will pay for it by continually surprising the expert. - Larry Wall

# This is a patch for 19523.ORIG to update it to 19523 # # To apply this patch​: # STEP 1​: Chdir to the source directory. # STEP 2​: Run the 'applypatch' program with this patch file as input. # # If you do not have 'applypatch'\, it is part of the 'makepatch' package # that you can fetch from the Comprehensive Perl Archive Network​: # http​://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz # In the above URL\, 'x' should be 2 or higher. # # To apply this patch without the use of 'applypatch'​: # STEP 1​: Chdir to the source directory. # STEP 2​: Run the 'patch' program with this file as input. # #### End of Preamble ####

#### Patch data follows #### diff -up '19523.ORIG/ext/B/B/Deparse.pm' '19523/ext/B/B/Deparse.pm' Index​: ./ext/B/B/Deparse.pm

Inline Patch ```diff --- ./ext/B/B/Deparse.pm Wed May 14 23:29:09 2003 +++ ./ext/B/B/Deparse.pm Fri May 16 12:19:34 2003 @@ -2363,7 +2363,7 @@ sub loop_common { # 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 # 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 third-to-last child is the continue # block (or the last in a bare loop). my $cont_start = $enter->nextop; my $cont; diff -up '19523.ORIG/ext/B/t/deparse.t' '19523/ext/B/t/deparse.t' ```

Index: ./ext/B/t/deparse.t

Inline Patch ```diff --- ./ext/B/t/deparse.t Wed May 14 23:29:09 2003 +++ ./ext/B/t/deparse.t Fri May 16 17:39:36 2003 @@ -15,7 +15,7 @@ use warnings; use strict; use Config; -print "1..18\n"; +print "1..25\n"; use B::Deparse; my $deparse = B::Deparse->new() or print "not "; @@ -196,3 +196,37 @@ my $foo = "Ab\x{100}\200\x{200}\377Cd\00 #### # 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; } diff -up '19523.ORIG/op.c' '19523/op.c' ```

Index: ./op.c

Inline Patch ```diff --- ./op.c Wed May 14 23:29:16 2003 +++ ./op.c Fri May 16 17:43:38 2003 @@ -3586,6 +3586,9 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 deb if (!next) next = unstack; cont = append_elem(OP_LINESEQ, cont, unstack); + /* this newstate will be optimised away (keeping it gives goto + * bugs), but having it here helps B::Deparse, especially to + * discriminate C verses C */ if ((line_t)whileline != NOLINE) { PL_copline = (line_t)whileline; cont = append_elem(OP_LINESEQ, cont, @@ -6329,6 +6332,15 @@ Perl_peep(pTHX_ register OP *o) peep(cLOOP->op_lastop); break; + case OP_UNSTACK: /* remove trailing nextstate: see newWHILEOP() */ + if ( o->op_next + && o->op_next == o->op_sibling + && ( o->op_next->op_type == OP_NEXTSTATE || + o->op_next->op_type == OP_DBSTATE) + ) + o->op_next = o->op_next->op_next; + break; + case OP_QR: case OP_MATCH: case OP_SUBST: diff -up '19523.ORIG/t/op/goto.t' '19523/t/op/goto.t' ```

Index: ./t/op/goto.t

Inline Patch ```diff --- ./t/op/goto.t Wed May 14 23:29:29 2003 +++ ./t/op/goto.t Thu May 15 00:26:13 2003 @@ -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,15 @@ 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++) { + goto LABEL29; + LABEL29: +} +print "ok 29 - goto in for(;;) with continuation\n"; + exit; bypass: diff -up '19523.ORIG/t/run/switchd.t' '19523/t/run/switchd.t' ```

Index: ./t/run/switchd.t

Inline Patch ```diff --- ./t/run/switchd.t Wed May 14 23:29:30 2003 +++ ./t/run/switchd.t Thu May 15 00:27:20 2003 @@ -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); } ```

End of Patch data

#### ApplyPatch data follows #### # Data version : 1.0 # Date generated : Fri May 16 18​:37​:27 2003 # Generated by : makepatch 2.00_05 # Recurse directories : Yes # Excluded files : keywords\.h|warnings\.h|regnodes\.h|perlapi\.c|perlapi\.h|global\.sym|embedvar\.h|embed\.h|pod\/perlapi\.pod|pod\/perlintern\.pod|proto\.h # v 'patchlevel.h' 4640 1052951380 33188 # p 'ext/B/B/Deparse.pm' 125634 1053083974 0100644 # p 'ext/B/t/deparse.t' 3386 1053103176 0100644 # p 'op.c' 159094 1053103418 0100644 # p 't/op/goto.t' 4208 1052954773 0100755 # p 't/run/switchd.t' 832 1052954840 0100644 #### End of ApplyPatch data ####

#### End of Patch kit [created​: Fri May 16 18​:37​:27 2003] #### #### Patch checksum​: 153 4596 9816 #### #### Checksum​: 171 5272 65445 ####

p5pRT commented 21 years ago

From enache@rdslink.ro

On Fri\, May 16\, 2003 at 07​:39​:32PM +0100\, Dave Mitchell wrote​:

It's too difficult to remove this nextstate altogether because Deparse.pm relies on it; so instead my patch optimises it away later in Perl_peep().

Is this a problem ? To quote Stephen McCamant​:

  I don't think that confusing Deparse should be a primary concern when   fixing the core. B​::Deparse consists almost entirely of workarounds   for various weird things that Perl does while compiling\, and it   doesn't hurt to add more.

So it's probably a good idea to remove that NEXTSTATE completely ( since it also means bloat/slowdown ) and negotiate a Deparse change.

Adi - you said you also had a fix for this bug - if your approach is as clean/cleaner\, please feel free to submit it too!

It isn't clean at all - if the term "clean" could apply to pp_goto.

Inline Patch ```diff --- /arc/bleadperl/pp_ctl.c 2003-05-12 00:22:19.000000000 +0300 +++ ./pp_ctl.c 2003-05-17 00:16:32.000000000 +0300 @@ -2411,6 +2411,8 @@ PP(pp_goto) } /* else fall through */ case CXt_LOOP: + if (in_block && !gotoprobe) + ix++; gotoprobe = cx->blk_oldcop->op_sibling; break; case CXt_SUBST: ```

[disclaimer: no sanity checked]

Regards\, Adi

p5pRT commented 21 years ago

From @iabyn

On Sat\, May 17\, 2003 at 12​:23​:36AM +0300\, Enache Adrian wrote​:

On Fri\, May 16\, 2003 at 07​:39​:32PM +0100\, Dave Mitchell wrote​:

It's too difficult to remove this nextstate altogether because Deparse.pm relies on it; so instead my patch optimises it away later in Perl_peep().

Is this a problem ? To quote Stephen McCamant​:

I don't think that confusing Deparse should be a primary concern when
fixing the core\. B&#8203;::Deparse consists almost entirely of workarounds
for various weird things that Perl does while compiling\, and it
doesn't hurt to add more\.

So it's probably a good idea to remove that NEXTSTATE completely ( since it also means bloat/slowdown ) and negotiate a Deparse change.

Well\, it has no run-time slowdown\, since the nextstate is removed from the op_next chain. I initially starting fixing Deparse to handle the removal of the nextstate altogether\, but got stumped on the   my $x; for $x (...) vs   for my $x (...) discrimination. Basically Deparse has no way of knowing whether the lexical was declared as part of the loop without being able to compare the cop seq numbers in the lex and in the nextstate op. So I gave up. Note also that just removing the nextstate without fixing Deparse first breaks just about all loop deparsing.

Opinions\, anyone? (especially Stephen).

Adi - you said you also had a fix for this bug - if your approach is as clean/cleaner\, please feel free to submit it too!

It isn't clean at all - if the term "clean" could apply to pp_goto.

--- /arc/bleadperl/pp_ctl.c 2003-05-12 00​:22​:19.000000000 +0300 +++ ./pp_ctl.c 2003-05-17 00​:16​:32.000000000 +0300 @​@​ -2411\,6 +2411\,8 @​@​ PP(pp_goto) } /* else fall through */ case CXt_LOOP​: + if (in_block && !gotoprobe) + ix++; gotoprobe = cx->blk_oldcop->op_sibling; break; case CXt_SUBST​:

[disclaimer​: no sanity checked]

Hmm\, its short and sweet\, but has rather the feel of stable door closing :-)

Dave.

-- Standards (n). Battle insignia or tribal totems.

p5pRT commented 21 years ago

From smcc@mit.edu

"DM" == Dave Mitchell \davem@&#8203;fdgroup\.com writes​:

DM> On Sat\, May 17\, 2003 at 12​:23​:36AM +0300\, Enache Adrian wrote​:

On Fri\, May 16\, 2003 at 07​:39​:32PM +0100\, Dave Mitchell wrote​: DM> It's too difficult to remove this nextstate altogether because DM> Deparse.pm relies on it; so instead my patch optimises it away DM> later in Perl_peep().

AE> Is this a problem ? To quote Stephen McCamant​:

SMcC> I don't think that confusing Deparse should be a primary concern SMcC> when fixing the core. B​::Deparse consists almost entirely of SMcC> workarounds for various weird things that Perl does while SMcC> compiling\, and it doesn't hurt to add more.

Let me expand on this a bit as a general principle. In theory\, it should never be necessary to change the core to get Deparse to work right; the most that should be needed is to give Deparse all the information that the OP-interpreting part of Perl has access to. Deparse's mission is to turn an OP tree into functionally equivalent code. If for two different input programs\, the OP tree is the same\, then the two programs will act the same\, and Deparse can de-parse them to the same code. If there is a difference in the OP trees\, then Deparse can use that difference to distinguish the two cases.

In practice\, of course\, this argument isn't air-tight. For one thing\, people are interested in Deparse preserving non-functional aspects of their code\, like which file subroutines came from (at issue in the Deparse/CopFILE question discussed recently). Another problem is that there's only a limited amount of programmer effort available to be spent on fixing Deparse.

AE> So it's probably a good idea to remove that NEXTSTATE completely ( AE> since it also means bloat/slowdown ) and negotiate a Deparse AE> change.

DM> Well\, it has no run-time slowdown\, since the nextstate is removed DM> from the op_next chain. I initially starting fixing Deparse to DM> handle the removal of the nextstate altogether\, but got stumped on DM> the DM> my $x; for $x (...) DM> vs DM> for my $x (...) DM> discrimination. Basically Deparse has no way of knowing whether DM> the lexical was declared as part of the loop without being able to DM> compare the cop seq numbers in the lex and in the nextstate op. So DM> I gave up. Note also that just removing the nextstate without DM> fixing Deparse first breaks just about all loop deparsing.

DM> Opinions\, anyone? (especially Stephen).

I haven't yet tried to think through a fix in detail\, but it seems to me that the looking-at-COP-sequence-numbers trick should be modifiable to look at different COPs. When you say "for my $x (...) {...}"\, the scope if the $x is only inside the curlies; when you say "my $x; for $x (...) {...}"\, $x's scope extends to the end of the enclosing block\, so you should be able to just compare $x's ending cop_seq with the sequence number of the next nextstate after the loop. If the two cases aren't distinguishable when the for loop is the last thing in its block\, that's okay\, because then there's no difference between the constructs.

Does that make sense?

-- Stephen

p5pRT commented 21 years ago

From @iabyn

On Sun\, May 18\, 2003 at 02​:24​:12AM -0400\, Stephen McCamant wrote​:

AE> So it's probably a good idea to remove that NEXTSTATE completely ( AE> since it also means bloat/slowdown ) and negotiate a Deparse AE> change.

DM> Well\, it has no run-time slowdown\, since the nextstate is removed DM> from the op_next chain. I initially starting fixing Deparse to DM> handle the removal of the nextstate altogether\, but got stumped on DM> the DM> my $x; for $x (...) DM> vs DM> for my $x (...) DM> discrimination. Basically Deparse has no way of knowing whether DM> the lexical was declared as part of the loop without being able to DM> compare the cop seq numbers in the lex and in the nextstate op. So DM> I gave up. Note also that just removing the nextstate without DM> fixing Deparse first breaks just about all loop deparsing.

DM> Opinions\, anyone? (especially Stephen).

I haven't yet tried to think through a fix in detail\, but it seems to me that the looking-at-COP-sequence-numbers trick should be modifiable to look at different COPs. When you say "for my $x (...) {...}"\, the scope if the $x is only inside the curlies; when you say "my $x; for $x (...) {...}"\, $x's scope extends to the end of the enclosing block\, so you should be able to just compare $x's ending cop_seq with the sequence number of the next nextstate after the loop. If the two cases aren't distinguishable when the for loop is the last thing in its block\, that's okay\, because then there's no difference between the constructs.

My current cunning plan is to set the OPpLVAL_INTRO flag in OP_ENTERITER's op_private flags to discriminate C\<my $x; for $x ()> and C\<for my $x ()>. The private flags aren't used by this op\, and it makes the deparsing a whole bunch easier.

I should have a revised patch in the next few days that removes the nextstate altogether and fixes up Deparse accordingly.

Dave.

-- Blaming Islam for 911 is like blaming Christianity for Oklahoma City.

p5pRT commented 21 years ago

From @iabyn

Here's my second attempt.

This patch

1) removes the trailing OP_NEXTSTATE from continue blocks\, which stops a goto coredump and the misreporting of line numbers in loops.

2) Adds the OPpLVAL_INTRO or OPpOUR_INTRO flags to OP_ENTERITER ops to indicate C\<for my $x ()> and C\<for our $x ()> respectively

3) fixes up Deparse to handle the lack of the nextstate\, and to use those two new flags for correct deparsing of the loop variable.

Note that Deparse used to drop the 'our' when deparsing C\<for our $x ()>.

-- Justice is when you get what you deserve. Law is when you get what you pay for.

# This is a patch for 19523.ORIG to update it to 19523.2 # # To apply this patch​: # STEP 1​: Chdir to the source directory. # STEP 2​: Run the 'applypatch' program with this patch file as input. # # If you do not have 'applypatch'\, it is part of the 'makepatch' package # that you can fetch from the Comprehensive Perl Archive Network​: # http​://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz # In the above URL\, 'x' should be 2 or higher. # # To apply this patch without the use of 'applypatch'​: # STEP 1​: Chdir to the source directory. # STEP 2​: Run the 'patch' program with this file as input. # #### End of Preamble ####

#### Patch data follows #### diff -up '19523.ORIG/ext/B/B/Concise.pm' '19523.2/ext/B/B/Concise.pm' Index​: ./ext/B/B/Concise.pm

Inline Patch ```diff --- ./ext/B/B/Concise.pm Wed May 14 23:29:09 2003 +++ ./ext/B/B/Concise.pm Wed May 21 22:38:04 2003 @@ -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 -up '19523.ORIG/ext/B/B/Deparse.pm' '19523.2/ext/B/B/Deparse.pm' ```

Index: ./ext/B/B/Deparse.pm

Inline Patch ```diff --- ./ext/B/B/Deparse.pm Wed May 14 23:29:09 2003 +++ ./ext/B/B/Deparse.pm Thu May 22 00:34:23 2003 @@ -2312,7 +2312,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 { @@ -2335,17 +2335,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); } @@ -2361,18 +2358,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 -up '19523.ORIG/ext/B/t/debug.t' '19523.2/ext/B/t/debug.t' ```

Index: ./ext/B/t/debug.t

Inline Patch ```diff --- ./ext/B/t/debug.t Wed May 14 23:29:09 2003 +++ ./ext/B/t/debug.t Thu May 22 00:11:56 2003 @@ -54,13 +54,13 @@ if ($is_thread) { $b=<

Index: ./ext/B/t/deparse.t

Inline Patch ```diff --- ./ext/B/t/deparse.t Wed May 14 23:29:09 2003 +++ ./ext/B/t/deparse.t Wed May 21 23:14:21 2003 @@ -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\00 #### # 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 -up '19523.ORIG/op.c' '19523.2/op.c' ```

Index: ./op.c

Inline Patch ```diff --- ./op.c Wed May 14 23:29:16 2003 +++ ./op.c Thu May 22 00:05:31 2003 @@ -3586,11 +3586,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 deb 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); @@ -3643,13 +3638,16 @@ Perl_newFOROP(pTHX_ I32 flags,char *labe 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); @@ -3708,6 +3706,9 @@ Perl_newFOROP(pTHX_ I32 flags,char *labe 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 -up '19523.ORIG/op.h' '19523.2/op.h' ```

Index: ./op.h

Inline Patch ```diff --- ./op.h Wed May 14 23:29:16 2003 +++ ./op.h Wed May 21 22:39:45 2003 @@ -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 -up '19523.ORIG/t/op/goto.t' '19523.2/t/op/goto.t' ```

Index: ./t/op/goto.t

Inline Patch ```diff --- ./t/op/goto.t Wed May 14 23:29:29 2003 +++ ./t/op/goto.t Thu May 22 00:42:05 2003 @@ -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 -up '19523.ORIG/t/run/switchd.t' '19523.2/t/run/switchd.t' ```

Index: ./t/run/switchd.t

Inline Patch ```diff --- ./t/run/switchd.t Wed May 14 23:29:30 2003 +++ ./t/run/switchd.t Thu May 15 00:27:20 2003 @@ -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); } ```

End of Patch data

#### ApplyPatch data follows #### # Data version : 1.0 # Date generated : Thu May 22 00​:43​:12 2003 # Generated by : makepatch 2.00_05 # Recurse directories : Yes # Excluded files : keywords\.h|warnings\.h|regnodes\.h|perlapi\.c|perlapi\.h|global\.sym|embedvar\.h|embed\.h|pod\/perlapi\.pod|pod\/perlintern\.pod|proto\.h # v 'patchlevel.h' 4640 1052951380 33188 # p 'ext/B/B/Concise.pm' 34041 1053553084 0100644 # p 'ext/B/B/Deparse.pm' 125634 1053560063 0100644 # p 'ext/B/t/debug.t' 1619 1053558716 0100755 # p 'ext/B/t/deparse.t' 3386 1053555261 0100644 # p 'op.c' 159094 1053558331 0100644 # p 'op.h' 15194 1053553185 0100644 # p 't/op/goto.t' 4208 1053560525 0100755 # p 't/run/switchd.t' 832 1052954840 0100644 #### End of ApplyPatch data ####

#### End of Patch kit [created​: Thu May 22 00​:43​:12 2003] #### #### Patch checksum​: 306 9839 227 #### #### Checksum​: 324 10516 55896 ####

p5pRT commented 21 years ago

From @iabyn

On Thu\, May 22\, 2003 at 10​:13​:19AM +0100\, Dave Mitchell wrote​:

This patch

1) removes the trailing OP_NEXTSTATE from continue blocks\, which stops a goto coredump and the misreporting of line numbers in loops.

2) Adds the OPpLVAL_INTRO or OPpOUR_INTRO flags to OP_ENTERITER ops to indicate C\<for my $x ()> and C\<for our $x ()> respectively

3) fixes up Deparse to handle the lack of the nextstate\, and to use those two new flags for correct deparsing of the loop variable.

4) has a stupid typo in the new goto test. Sometimes I think I'm really not safe to be let out of my sandbox...

-- To collect all the latest movies\, simply place an unprotected ftp server on the Internet\, and wait for the disk to fill....

Inline Patch ```diff --- t/op/goto.t- Fri May 23 17:02:51 2003 +++ t/op/goto.t Fri May 23 17:04:32 2003 @@ -192,7 +192,7 @@ my $x = 1; goto LABEL29; LABEL29: - print "not " if !defined $x | $x != 1; + print "not " if !defined $x || $x != 1; } print "ok 29 - goto in for(;;) with continuation\n"; ```
p5pRT commented 21 years ago

From @jhi

Thanks\, applied the #2 plus the goto.t patchlet.

-- Jarkko Hietaniemi \jhi@&#8203;iki\.fi http​://www.iki.fi/jhi/ "There is this special biologist word we use for 'stable'. It is 'dead'." -- Jack Cohen

p5pRT commented 21 years ago

@iabyn - Status changed from 'new' to 'resolved'