search

Perl / perl5

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

my-variables lose values while goto'ing within a for(;;)-loop #3544

Closed p5pRT closed 21 years ago

p5pRT commented 24 years ago

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

Searchable as RT5998$

p5pRT commented 24 years ago

From ts@snafu.de

Dear maintainers\,

the following program behaves unexpected​:

#-------------------------------------------------- #!/usr/bin/perl

for ($i=1; $i\<=1; $i++) {   my $var='val';   print "before \$var='$var'\n";   goto Jump;   Jump​:   print "after \$var='$var'\n"; } #--------------------------------------------------

The output is​:

#-------------------------------------------------- before $var='val' after $var='' #--------------------------------------------------

It seems\, all ingredients (C-style for\, my-variable\, goto) are crucial; e.g. a for(1)-loop behaves as expected.

I think it would be a good idea to correct this glitch in an otherwise excellent language.

Sincerely\, Thomas Schmitt

Perl Info ``` Flags: category=core severity=medium Site configuration information for perl v5.6.0: Configured by bod at Tue Feb 27 03:27:16 EST 2001. Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration: Platform: osname=linux, osvers=2.2.18, archname=i386-linux uname='linux duende 2.2.18 #1 thu dec 28 14:51:40 est 2000 i686 unknown ' config_args='-Dccflags=-DDEBIAN -Darchname=i386-linux -Dprefix=/usr -Dprivlib=/usr/share/perl/5.6.0 -Darchlib=/usr/lib/perl/5.6.0 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.6.0 -Dsitearch=/usr/local/lib/perl/5.6.0 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dman1ext=1 -Dman3ext=3 -Dpager=/usr/bin/pager -Uafs -Ud_csh -Uusesfio -Duseshrplib -Dlibperl=libperl.so.5.6.0 -Dd_dosuid -des' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=undef d_sfio=undef uselargefiles=define use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef Compiler: cc='cc', optimize='-O2', gccversion=2.95.3 20010219 (prerelease) cppflags='-DDEBIAN -fno-strict-aliasing -I/usr/local/include' ccflags ='-DDEBIAN -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' stdchar='char', d_stdstdio=define, usevfork=false intsize=4, longsize=4, ptrsize=4, doublesize=8 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=4, usemymalloc=n, prototype=define Linker and Libraries: ld='cc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lnsl -ldl -lm -lc -lcrypt libc=/lib/libc-2.2.2.so, so=so, useshrplib=true, libperl=libperl.so.5.6.0 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.0: /usr/local/lib/perl/5.6.0 /usr/local/share/perl/5.6.0 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.6.0 /usr/share/perl/5.6.0 /usr/lib/perl5/5.6/i386-linux /usr/lib/perl5/5.6 /usr/lib/perl5/5.005/i386-linux . Environment for perl v5.6.0: HOME=/home/ts LANG=de_DE LANGUAGE (unset) LD_LIBRARY_PATH=/usr/lib LOGDIR (unset) PATH=/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games:/usr/local/mybin:/opt/kde/bin:/home/ts/bin PERL_BADLANG (unset) SHELL=/bin/bash ```
p5pRT commented 24 years ago

From [Unknown Contact. See original ticket]

Wow! This is a venerable bug\, dating at least back to 5.00404.

When a for(;;) is compiled\, there's no nextstate immediately before the enterloop\, and so when pp_goto does this​:

  case CXt_LOOP​:   gotoprobe = cx->blk_oldcop->op_sibling;   break;

gotoprobe ends up pointing into a dead end.

That means that the label doesn't get found until the next context up is searched; and so the loop context is left and re-entered when the goto is executed.

I'm not sure whether it is the best fix\, but the patch below seems to solve the problem (and still passes all tests).

[The alternative approach\, I suppose\, would be to say that pp_goto is making unreasonable assumptions]

You'll have to make run_byacc of course​: perly_c.diff will still apply but with fuzz of one line in the final hunk.

.robin.

Inline Patch ```diff --- perly.y.orig Fri Mar 9 23:24:30 2001 +++ perly.y Sat Mar 10 00:19:03 2001 @@ -249,9 +249,10 @@ /* basically fake up an initialize-while lineseq */ { OP *forop = append_elem(OP_LINESEQ, scalar($5), - newWHILEOP(0, 1, (LOOP*)Nullop, - $2, scalar($7), - $11, scalar($9))); + newSTATEOP(0, Nullch, + newWHILEOP(0, 1, (LOOP*)Nullop, + $2, scalar($7), + $11, scalar($9)))); PL_copline = $2; $$ = block_end($4, newSTATEOP(0, $1, forop)); } | label block cont /* a block is a loop that happens once */ ```
p5pRT commented 24 years ago

From [Unknown Contact. See original ticket]

On 10 Mar 2001\, at 2​:14\, Robin Houston wrote​:

I'm not sure whether it is the best fix\, but the patch below seems to solve the problem (and still passes all tests).

Are you going to provide a test case as well that will show in the future whether this bug does not exist?

Otherwise\, the snippet in the original bug report could probably be used\, but I don't know which test script it should wander into​:

  for ($i=1; $i\<=1; $i++) {   my $var='val';   print "before \$var='$var'\n";   goto Jump;   Jump​:   print "after \$var='$var'\n";   }

and check that $var is correctly set after the goto.

Cheers\, Philip

p5pRT commented 24 years ago

From [Unknown Contact. See original ticket]

On Mon\, Mar 12\, 2001 at 05​:08​:00PM +0100\, Philip Newton wrote​:

Are you going to provide a test case as well that will show in the future whether this bug does not exist?

Sure! See below. (Patch against 5.7.0)

I was really waiting for someone to tell me whether or not the patch was okay before doing any more work on it. But since a) nobody has complained yet\, and b) the test is trivial\, here it is :-)

.robin.

Inline Patch ```diff --- t/op/goto.t.orig Mon Mar 12 16:46:53 2001 +++ t/op/goto.t Mon Mar 12 16:49:31 2001 @@ -2,7 +2,7 @@ # "This IS structured code. It's just randomly structured." -print "1..16\n"; +print "1..17\n"; while ($?) { $foo = 1; @@ -76,6 +76,16 @@ } } print "ok 16\n"; + +# Does goto work correctly within a for(;;) loop? +# (BUG ID 20010309.004) + +for(my $i=0;!$i++;) { + my $x=1; + goto label; + label: print (defined $x?"ok ": "not ok ", "17\n") +} + exit; bypass: ```
p5pRT commented 24 years ago

From [Unknown Contact. See original ticket]

In article \20010312165814\.A12249@&#8203;puffinry\.freeserve\.co\.uk\,   Robin Houston \robin@&#8203;kitsite\.com writes​:

This sounds extremely simular to http​://bugs.perl.org/perlbug.cgi?req=bid&bid=20000313.004&range=10985&format=H&trim=25

Does it happen to fix that too ?

p5pRT commented 24 years ago

From @jhi

On Sat\, Mar 10\, 2001 at 02​:14​:31AM +0000\, Robin Houston wrote​:

Wow! This is a venerable bug\, dating at least back to 5.00404.

When a for(;;) is compiled\, there's no nextstate immediately before the enterloop\, and so when pp_goto does this​:

        case CXt\_LOOP&#8203;:
            gotoprobe = cx\->blk\_oldcop\->op\_sibling;
            break;

gotoprobe ends up pointing into a dead end.

That means that the label doesn't get found until the next context up is searched; and so the loop context is left and re-entered when the goto is executed.

I'm not sure whether it is the best fix\, but the patch below seems to solve the problem (and still passes all tests).

In 5.7.0+ the lib/tie-substrhash fails​:

ok 15 Exiting subroutine via next at ../lib/Tie/SubstrHash.pm line 201. Label not found for "next NUM" at ../lib/Tie/SubstrHash.pm line 201.

Here's the code​:

# using POSIX​::ceil() would be too heavy\, and not all platforms have it. sub ceil {   my $num = shift;   $num = int($num + 1) unless $num == int $num;   return $num; }

sub findgteprime { # find the smallest prime integer greater than or equal to   use integer;

# It may be sufficient (and more efficient\, IF IT IS CORRECT) to use # $max = 1 + int sqrt $num and calculate it once only\, but is it correct?

  my $num = ceil(shift);   return 2 if $num \<= 2;

  $num++ unless $num % 2;

  NUM​:   for (;; $num += 2) {   my $max = int sqrt $num;   for ($i = 3; $i \<= $max; $i += 2) {   next NUM unless $num % $i;   }   return $num;   } }

p5pRT commented 24 years ago

From [Unknown Contact. See original ticket]

On Mon\, 12 Mar 2001 at 18​:24​:53\, Jarkko laid this on us​:

sub findgteprime { # find the smallest prime integer greater than or equal to use integer;

# It may be sufficient (and more efficient\, IF IT IS CORRECT) to use # $max = 1 + int sqrt $num and calculate it once only\, but is it correct?

my $num = ceil\(shift\);
return 2 if $num \<= 2;

$num\+\+ unless $num % 2;

NUM​: for (;; $num += 2) { my $max = int sqrt $num; for ($i = 3; $i \<= $max; $i += 2) { next NUM unless $num % $i; } return $num; } }

A bit off the real topic\, for which I apologize\, but\, according to

http​://www-groups.dcs.st-andrews.ac.uk/~history/HistTopics/Prime_numbers.html

the following is an unsolved problem​:

4. Is there always a prime between n ** 2 and (n + 1) ** 2 ?   (The fact that there is always a prime between n and 2n was called   Bertrand's conjecture and was proved by Chebyshev.)

If n in the unsolved problem is int sqrt $num\, then the algorithm works iff there *is* a prime between n ** 2 and (n + 1) ** 2\, solving the problem. My gambling side would favor the existence of such a prime\, but I don't like to gamble with code.

findgteprime3 benchmarks as well as the uncertain algorithm (findgteprime1) (at least on my Intel PC and an SGI box)\, and doesn't rely on the status of unsolved problems. But there isn't a *lot* of difference in the runtime of any of the algorithms. -- jpl

=======

use Benchmark;

# using POSIX​::ceil() would be too heavy\, and not all platforms have it. sub ceil {   my $num = shift;   $num = int($num + 1) unless $num == int $num;   return $num; }

sub findgteprime1 { # find the smallest prime integer greater than or equal to   use integer;

# It may be sufficient (and more efficient\, IF IT IS CORRECT) to use # $max = 1 + int sqrt $num and calculate it once only\, but is it correct?

  my $num = ceil(shift);   return 2 if $num \<= 2;

  $num++ unless $num % 2;   my $max = 1 + int sqrt $num;   my $i;

  NUM​:   for (;; $num += 2) {   for ($i = 3; $i \<= $max; $i += 2) {   next NUM unless $num % $i;   }   return $num;   } }

sub findgteprime2 { # find the smallest prime integer greater than or equal to   use integer;

# It may be sufficient (and more efficient\, IF IT IS CORRECT) to use # $max = 1 + int sqrt $num and calculate it once only\, but is it correct?

  my $num = ceil(shift);   return 2 if $num \<= 2;

  $num++ unless $num % 2;   my $i;

  NUM​:   for (;; $num += 2) {   my $max = int sqrt $num;   for ($i = 3; $i \<= $max; $i += 2) {   next NUM unless $num % $i;   }   return $num;   } }

sub findgteprime3 { # find the smallest prime integer greater than or equal to   use integer;

  my $num = ceil(shift);   return 2 if $num \<= 2;

  $num++ unless $num % 2;   my $i;   my $sqrtnum = int sqrt $num;   my $sqrtnumsquared = $sqrtnum * $sqrtnum;

  NUM​:   for (;; $num += 2) {   if ($sqrtnumsquared \< $num) {   $sqrtnum++;   $sqrtnumsquared = $sqrtnum * $sqrtnum;   }   for ($i = 3; $i \<= $sqrtnum; $i += 2) {   next NUM unless $num % $i;   }   return $num;   } }

$n = 500000; $t = $i = 0; timethis($n\, '$t += findgteprime1($i); $i++'); print("\$t = $t\n"); $t = $i = 0; timethis($n\, '$t += findgteprime2($i); $i++'); print("\$t = $t\n"); $t = $i = 0; timethis($n\, '$t += findgteprime3($i); $i++'); print("\$t = $t\n");

==============

Intel results​:

timethis 500000​: 565 wallclock secs (258.29 usr + 1.15 sys = 259.44 CPU) @​ 1927.23/s (n=500000) $t = 125004425341 timethis 500000​: 608 wallclock secs (277.77 usr + 1.38 sys = 279.15 CPU) @​ 1791.15/s (n=500000) $t = 125004425341 timethis 500000​: 534 wallclock secs (256.53 usr + 0.70 sys = 257.23 CPU) @​ 1943.79/s (n=500000) $t = 125004425341

SGI results​:

timethis 500000​: 630 wallclock secs (626.84 usr + 0.40 sys = 627.24 CPU) @​ 797.14/s (n=500000) $t = 125004425341 timethis 500000​: 629 wallclock secs (627.30 usr + 0.40 sys = 627.70 CPU) @​ 796.56/s (n=500000) $t = 125004425341 timethis 500000​: 627 wallclock secs (624.89 usr + 0.41 sys = 625.30 CPU) @​ 799.62/s (n=500000) $t = 125004425341

p5pRT commented 24 years ago

From @jhi

A bit off the real topic\, for which I apologize\, but\, according to

http​://www-groups.dcs.st-andrews.ac.uk/~history/HistTopics/Prime_numbers.html

the following is an unsolved problem​:

4. Is there always a prime between n ** 2 and (n + 1) ** 2 ? (The fact that there is always a prime between n and 2n was called Bertrand's conjecture and was proved by Chebyshev.)

If n in the unsolved problem is int sqrt $num\, then the algorithm works iff there *is* a prime between n ** 2 and (n + 1) ** 2\, solving the problem. My gambling side would favor the existence of such a prime\, but I don't like to gamble with code.

Thanks. Good that we have number theoreticians among us :-)

p5pRT commented 24 years ago

From [Unknown Contact. See original ticket]

As Jarkko pointed out\, my last patch simply switched one kind of brokenness for a different (probably worse) one. Sorry.

Below is round two.

I've added a new test file\, op/loopctl.t which gives the loop control operators (last\, next\, redo) a thorough workout. The bug addressed here and some plausible variants are tested by three new tests in op/goto.t

What I've done is to compile this​:

  LABEL​: for(A; B; C) {D}

as though it were​:

  LABEL​: A;   LABEL​: while(B) {D} continue {C}

duplicating the label may look like madness\, but it makes the construct behave as expected​: because of the way that goto searches for labels it will always find the first occurence; whereas last/next/redo will always find the second occurence.

Incidentally\, perl will currently give the "Use of implicit split to @​_" warning TWICE for things like perl -wce 'for(;;split) {}' I fixed that too.

perl-mvs is CCed because perly.y is patched. I got rid of the fuzz from perly_c.diff - so there's a patch of a patch there.

Patch is against perl-current (as of yesterday).

.robin.

Inline Patch ```diff --- perl-current/MANIFEST Tue Mar 13 01:14:35 2001 +++ perl-robin/MANIFEST Tue Mar 13 16:10:54 2001 @@ -1599,6 +1599,7 @@ t/op/lfs.t See if large files work for perlio t/op/list.t See if array lists work t/op/local.t See if local works +t/op/loopctl.t See if next/last/redo work t/op/lop.t See if logical operators work t/op/magic.t See if magic variables work t/op/method.t See if method calls work --- perl-current/AUTHORS Tue Feb 27 06:15:08 2001 +++ perl-robin/AUTHORS Tue Mar 13 16:40:18 2001 @@ -449,7 +449,7 @@ Robert Sanders Robert Spier Robin Barker -Robin Houston +Robin Houston Rocco Caputo Roderick Schertler Rodger Anderson --- perl-current/perly.y Fri Mar 9 01:22:12 2001 +++ perl-robin/perly.y Tue Mar 13 23:42:48 2001 @@ -248,13 +248,20 @@ newFOROP(0, $1, $2, Nullop, $5, $7, $8)); } | label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock /* basically fake up an initialize-while lineseq */ - { OP *forop = append_elem(OP_LINESEQ, - scalar($5), - newWHILEOP(0, 1, (LOOP*)Nullop, - $2, scalar($7), - $11, scalar($9))); + { OP *forop; PL_copline = $2; - $$ = block_end($4, newSTATEOP(0, $1, forop)); } + forop = newSTATEOP(0, $1, + newWHILEOP(0, 1, (LOOP*)Nullop, + $2, scalar($7), + $11, $9)); + if ($5) { + forop = append_elem(OP_LINESEQ, + newSTATEOP(0, ($1?savepv($1):Nullch), + $5), + forop); + } + + $$ = block_end($4, forop); } | label block cont /* a block is a loop that happens once */ { $$ = newSTATEOP(0, $1, newWHILEOP(0, 1, (LOOP*)Nullop, --- perl-current/perly_c.diff Tue Aug 1 03:32:01 2000 +++ perl-robin/perly_c.diff Wed Mar 14 00:04:40 2001 @@ -1,7 +1,7 @@ *** y.tab.c.orig Thu Aug 26 22:31:26 1999 --- y.tab.c Thu Aug 26 22:32:22 1999 *************** -*** 1447,1456 **** +*** 1448,1457 **** yyparse() { register int yym, yyn, yystate; @@ -12,7 +12,7 @@ if (yys = getenv("YYDEBUG")) { yyn = *yys; ---- 1447,1476 ---- +--- 1448,1477 ---- yyparse() { register int yym, yyn, yystate; @@ -44,8 +44,8 @@ { yyn = *yys; *************** -*** 1463,1468 **** ---- 1483,1498 ---- +*** 1464,1469 **** +--- 1484,1499 ---- yyerrflag = 0; yychar = (-1); @@ -63,7 +63,7 @@ yyvsp = yyvs; *yyssp = yystate = 0; *************** -*** 1493,1499 **** +*** 1494,1500 **** #endif if (yyssp >= yyss + yystacksize - 1) { @@ -71,7 +71,7 @@ } *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; ---- 1523,1541 ---- +--- 1524,1542 ---- #endif if (yyssp >= yyss + yystacksize - 1) { @@ -92,7 +92,7 @@ *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; *************** -*** 1534,1540 **** +*** 1535,1541 **** #endif if (yyssp >= yyss + yystacksize - 1) { @@ -100,7 +100,7 @@ } *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; ---- 1576,1594 ---- +--- 1577,1595 ---- #endif if (yyssp >= yyss + yystacksize - 1) { @@ -121,7 +121,7 @@ *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; *************** -*** 2473,2487 **** +*** 2481,2495 **** #endif if (yyssp >= yyss + yystacksize - 1) { @@ -137,7 +137,7 @@ yyaccept: ! return (0); } ---- 2527,2575 ---- +--- 2535,2583 ---- #endif if (yyssp >= yyss + yystacksize - 1) { --- perl-current/t/op/goto.t Tue Aug 1 03:32:13 2000 +++ perl-robin/t/op/goto.t Wed Mar 14 00:31:42 2001 @@ -2,7 +2,7 @@ # "This IS structured code. It's just randomly structured." -print "1..16\n"; +print "1..19\n"; while ($?) { $foo = 1; @@ -76,6 +76,36 @@ } } print "ok 16\n"; + +# Does goto work correctly within a for(;;) loop? +# (BUG ID 20010309.004) + +for(my $i=0;!$i++;) { + my $x=1; + goto label; + label: print (defined $x?"ok ": "not ok ", "17\n") +} + +# Does goto work correctly going *to* a for(;;) loop? +# (make sure it doesn't skip the initializer) + +my ($z, $y) = (0); +FORL1: for($y="ok 18\n"; $z;) {print $y; goto TEST19} +($y,$z) = ("not ok 18\n", 1); +goto FORL1; + +# Even from within the loop? + +TEST19: $z = 0; +FORL2: for($y="ok 19\n"; 1;) { + if ($z) { + print $y; + last; + } + ($y, $z) = ("not ok 19\n", 1); + goto FORL2; +} + exit; bypass: --- /dev/null Tue May 5 21:32:27 1998 +++ perl-robin/t/op/loopctl.t Wed Mar 14 00:40:09 2001 @@ -0,0 +1,925 @@ +#!./perl + +# We have the following types of loop: +# +# 1a) while(A) {B} +# 1b) B while A; +# +# 2a) until(A) {B} +# 2b) B until A; +# +# 3a) for(@A) {B} +# 3b) B for A; +# +# 4a) for (A;B;C) {D} +# +# 5a) { A } # a bare block is a loop which runs once +# +# Loops of type (b) don't allow for next/last/redo style +# control, so we ignore them here. Type (a) loops can +# all be labelled, so there are ten possibilities (each +# of 5 types, labelled/unlabelled). We therefore need +# thirty tests to try the three control statements against +# the ten types of loop. For the first four types it's useful +# to distinguish the case where next re-iterates from the case +# where it leaves the loop. That makes 38. +# All these tests rely on "last LABEL" +# so if they've *all* failed, maybe you broke that... +# +# These tests are followed by an extra test of nested loops. +# Feel free to add more here. +# +# -- .robin. 2001-03-13 + +print "1..39\n"; + +my $ok; + +## while() loop without a label + +TEST1: { # redo + + $ok = 0; + + my $x = 1; + my $first_time = 1; + while($x--) { + if (!$first_time) { + $ok = 1; + last TEST1; + } + $ok = 0; + $first_time = 0; + redo; + last TEST1; + } + continue { + $ok = 0; + last TEST1; + } + $ok = 0; +} +print ($ok ? "ok 1\n" : "not ok 1\n"); + +TEST2: { # next (succesful) + + $ok = 0; + + my $x = 2; + my $first_time = 1; + my $been_in_continue = 0; + while($x--) { + if (!$first_time) { + $ok = $been_in_continue; + last TEST2; + } + $ok = 0; + $first_time = 0; + next; + last TEST2; + } + continue { + $been_in_continue = 1; + } + $ok = 0; +} +print ($ok ? "ok 2\n" : "not ok 2\n"); + +TEST3: { # next (unsuccesful) + + $ok = 0; + + my $x = 1; + my $first_time = 1; + my $been_in_loop = 0; + my $been_in_continue = 0; + while($x--) { + $been_in_loop = 1; + if (!$first_time) { + $ok = 0; + last TEST3; + } + $ok = 0; + $first_time = 0; + next; + last TEST3; + } + continue { + $been_in_continue = 1; + } + $ok = $been_in_loop && $been_in_continue; +} +print ($ok ? "ok 3\n" : "not ok 3\n"); + +TEST4: { # last + + $ok = 0; + + my $x = 1; + my $first_time = 1; + while($x++) { + if (!$first_time) { + $ok = 0; + last TEST4; + } + $ok = 0; + $first_time = 0; + last; + last TEST4; + } + continue { + $ok = 0; + last TEST4; + } + $ok = 1; +} +print ($ok ? "ok 4\n" : "not ok 4\n"); + + +## until() loop without a label + +TEST5: { # redo + + $ok = 0; + + my $x = 0; + my $first_time = 1; + until($x++) { + if (!$first_time) { + $ok = 1; + last TEST5; + } + $ok = 0; + $first_time = 0; + redo; + last TEST5; + } + continue { + $ok = 0; + last TEST5; + } + $ok = 0; +} +print ($ok ? "ok 5\n" : "not ok 5\n"); + +TEST6: { # next (succesful) + + $ok = 0; + + my $x = 0; + my $first_time = 1; + my $been_in_continue = 0; + until($x++ >= 2) { + if (!$first_time) { + $ok = $been_in_continue; + last TEST6; + } + $ok = 0; + $first_time = 0; + next; + last TEST6; + } + continue { + $been_in_continue = 1; + } + $ok = 0; +} +print ($ok ? "ok 6\n" : "not ok 6\n"); + +TEST7: { # next (unsuccesful) + + $ok = 0; + + my $x = 0; + my $first_time = 1; + my $been_in_loop = 0; + my $been_in_continue = 0; + until($x++) { + $been_in_loop = 1; + if (!$first_time) { + $ok = 0; + last TEST7; + } + $ok = 0; + $first_time = 0; + next; + last TEST7; + } + continue { + $been_in_continue = 1; + } + $ok = $been_in_loop && $been_in_continue; +} +print ($ok ? "ok 7\n" : "not ok 7\n"); + +TEST8: { # last + + $ok = 0; + + my $x = 0; + my $first_time = 1; + until($x++ == 10) { + if (!$first_time) { + $ok = 0; + last TEST8; + } + $ok = 0; + $first_time = 0; + last; + last TEST8; + } + continue { + $ok = 0; + last TEST8; + } + $ok = 1; +} +print ($ok ? "ok 8\n" : "not ok 8\n"); + +## for(@array) loop without a label + +TEST9: { # redo + + $ok = 0; + + my $first_time = 1; + for(1) { + if (!$first_time) { + $ok = 1; + last TEST9; + } + $ok = 0; + $first_time = 0; + redo; + last TEST9; + } + continue { + $ok = 0; + last TEST9; + } + $ok = 0; +} +print ($ok ? "ok 9\n" : "not ok 9\n"); + +TEST10: { # next (succesful) + + $ok = 0; + + my $first_time = 1; + my $been_in_continue = 0; + for(1,2) { + if (!$first_time) { + $ok = $been_in_continue; + last TEST10; + } + $ok = 0; + $first_time = 0; + next; + last TEST10; + } + continue { + $been_in_continue = 1; + } + $ok = 0; +} +print ($ok ? "ok 10\n" : "not ok 10\n"); + +TEST11: { # next (unsuccesful) + + $ok = 0; + + my $first_time = 1; + my $been_in_loop = 0; + my $been_in_continue = 0; + for(1) { + $been_in_loop = 1; + if (!$first_time) { + $ok = 0; + last TEST11; + } + $ok = 0; + $first_time = 0; + next; + last TEST11; + } + continue { + $been_in_continue = 1; + } + $ok = $been_in_loop && $been_in_continue; +} +print ($ok ? "ok 11\n" : "not ok 11\n"); + +TEST12: { # last + + $ok = 0; + + my $first_time = 1; + for(1..10) { + if (!$first_time) { + $ok = 0; + last TEST12; + } + $ok = 0; + $first_time = 0; + last; + last TEST12; + } + continue { + $ok=0; + last TEST12; + } + $ok = 1; +} +print ($ok ? "ok 12\n" : "not ok 12\n"); + +## for(;;) loop without a label + +TEST13: { # redo + + $ok = 0; + + for(my $first_time = 1; 1;) { + if (!$first_time) { + $ok = 1; + last TEST13; + } + $ok = 0; + $first_time=0; + + redo; + last TEST13; + } + $ok = 0; +} +print ($ok ? "ok 13\n" : "not ok 13\n"); + +TEST14: { # next (successful) + + $ok = 0; + + for(my $first_time = 1; 1; $first_time=0) { + if (!$first_time) { + $ok = 1; + last TEST14; + } + $ok = 0; + next; + last TEST14; + } + $ok = 0; +} +print ($ok ? "ok 14\n" : "not ok 14\n"); + +TEST15: { # next (unsuccesful) + + $ok = 0; + + my $x=1; + my $been_in_loop = 0; + for(my $first_time = 1; $x--;) { + $been_in_loop = 1; + if (!$first_time) { + $ok = 0; + last TEST15; + } + $ok = 0; + $first_time = 0; + next; + last TEST15; + } + $ok = $been_in_loop; +} +print ($ok ? "ok 15\n" : "not ok 15\n"); + +TEST16: { # last + + $ok = 0; + + for(my $first_time = 1; 1; last TEST16) { + if (!$first_time) { + $ok = 0; + last TEST16; + } + $ok = 0; + $first_time = 0; + last; + last TEST16; + } + $ok = 1; +} +print ($ok ? "ok 16\n" : "not ok 16\n"); + +## bare block without a label + +TEST17: { # redo + + $ok = 0; + my $first_time = 1; + + { + if (!$first_time) { + $ok = 1; + last TEST17; + } + $ok = 0; + $first_time=0; + + redo; + last TEST17; + } + continue { + $ok = 0; + last TEST17; + } + $ok = 0; +} +print ($ok ? "ok 17\n" : "not ok 17\n"); + +TEST18: { # next + + $ok = 0; + { + next; + last TEST18; + } + continue { + $ok = 1; + last TEST18; + } + $ok = 0; +} +print ($ok ? "ok 18\n" : "not ok 18\n"); + +TEST19: { # last + + $ok = 0; + { + last; + last TEST19; + } + continue { + $ok = 0; + last TEST19; + } + $ok = 1; +} +print ($ok ? "ok 19\n" : "not ok 19\n"); + + +### Now do it all again with labels + +## while() loop with a label + +TEST20: { # redo + + $ok = 0; + + my $x = 1; + my $first_time = 1; + LABEL20: while($x--) { + if (!$first_time) { + $ok = 1; + last TEST20; + } + $ok = 0; + $first_time = 0; + redo LABEL20; + last TEST20; + } + continue { + $ok = 0; + last TEST20; + } + $ok = 0; +} +print ($ok ? "ok 20\n" : "not ok 20\n"); + +TEST21: { # next (succesful) + + $ok = 0; + + my $x = 2; + my $first_time = 1; + my $been_in_continue = 0; + LABEL21: while($x--) { + if (!$first_time) { + $ok = $been_in_continue; + last TEST21; + } + $ok = 0; + $first_time = 0; + next LABEL21; + last TEST21; + } + continue { + $been_in_continue = 1; + } + $ok = 0; +} +print ($ok ? "ok 21\n" : "not ok 21\n"); + +TEST22: { # next (unsuccesful) + + $ok = 0; + + my $x = 1; + my $first_time = 1; + my $been_in_loop = 0; + my $been_in_continue = 0; + LABEL22: while($x--) { + $been_in_loop = 1; + if (!$first_time) { + $ok = 0; + last TEST22; + } + $ok = 0; + $first_time = 0; + next LABEL22; + last TEST22; + } + continue { + $been_in_continue = 1; + } + $ok = $been_in_loop && $been_in_continue; +} +print ($ok ? "ok 22\n" : "not ok 22\n"); + +TEST23: { # last + + $ok = 0; + + my $x = 1; + my $first_time = 1; + LABEL23: while($x++) { + if (!$first_time) { + $ok = 0; + last TEST23; + } + $ok = 0; + $first_time = 0; + last LABEL23; + last TEST23; + } + continue { + $ok = 0; + last TEST23; + } + $ok = 1; +} +print ($ok ? "ok 23\n" : "not ok 23\n"); + + +## until() loop with a label + +TEST24: { # redo + + $ok = 0; + + my $x = 0; + my $first_time = 1; + LABEL24: until($x++) { + if (!$first_time) { + $ok = 1; + last TEST24; + } + $ok = 0; + $first_time = 0; + redo LABEL24; + last TEST24; + } + continue { + $ok = 0; + last TEST24; + } + $ok = 0; +} +print ($ok ? "ok 24\n" : "not ok 24\n"); + +TEST25: { # next (succesful) + + $ok = 0; + + my $x = 0; + my $first_time = 1; + my $been_in_continue = 0; + LABEL25: until($x++ >= 2) { + if (!$first_time) { + $ok = $been_in_continue; + last TEST25; + } + $ok = 0; + $first_time = 0; + next LABEL25; + last TEST25; + } + continue { + $been_in_continue = 1; + } + $ok = 0; +} +print ($ok ? "ok 25\n" : "not ok 25\n"); + +TEST26: { # next (unsuccesful) + + $ok = 0; + + my $x = 0; + my $first_time = 1; + my $been_in_loop = 0; + my $been_in_continue = 0; + LABEL26: until($x++) { + $been_in_loop = 1; + if (!$first_time) { + $ok = 0; + last TEST26; + } + $ok = 0; + $first_time = 0; + next LABEL26; + last TEST26; + } + continue { + $been_in_continue = 1; + } + $ok = $been_in_loop && $been_in_continue; +} +print ($ok ? "ok 26\n" : "not ok 26\n"); + +TEST27: { # last + + $ok = 0; + + my $x = 0; + my $first_time = 1; + LABEL27: until($x++ == 10) { + if (!$first_time) { + $ok = 0; + last TEST27; + } + $ok = 0; + $first_time = 0; + last LABEL27; + last TEST27; + } + continue { + $ok = 0; + last TEST8; + } + $ok = 1; +} +print ($ok ? "ok 27\n" : "not ok 27\n"); + +## for(@array) loop with a label + +TEST28: { # redo + + $ok = 0; + + my $first_time = 1; + LABEL28: for(1) { + if (!$first_time) { + $ok = 1; + last TEST28; + } + $ok = 0; + $first_time = 0; + redo LABEL28; + last TEST28; + } + continue { + $ok = 0; + last TEST28; + } + $ok = 0; +} +print ($ok ? "ok 28\n" : "not ok 28\n"); + +TEST29: { # next (succesful) + + $ok = 0; + + my $first_time = 1; + my $been_in_continue = 0; + LABEL29: for(1,2) { + if (!$first_time) { + $ok = $been_in_continue; + last TEST29; + } + $ok = 0; + $first_time = 0; + next LABEL29; + last TEST29; + } + continue { + $been_in_continue = 1; + } + $ok = 0; +} +print ($ok ? "ok 29\n" : "not ok 29\n"); + +TEST30: { # next (unsuccesful) + + $ok = 0; + + my $first_time = 1; + my $been_in_loop = 0; + my $been_in_continue = 0; + LABEL30: for(1) { + $been_in_loop = 1; + if (!$first_time) { + $ok = 0; + last TEST30; + } + $ok = 0; + $first_time = 0; + next LABEL30; + last TEST30; + } + continue { + $been_in_continue = 1; + } + $ok = $been_in_loop && $been_in_continue; +} +print ($ok ? "ok 30\n" : "not ok 30\n"); + +TEST31: { # last + + $ok = 0; + + my $first_time = 1; + LABEL31: for(1..10) { + if (!$first_time) { + $ok = 0; + last TEST31; + } + $ok = 0; + $first_time = 0; + last LABEL31; + last TEST31; + } + continue { + $ok=0; + last TEST31; + } + $ok = 1; +} +print ($ok ? "ok 31\n" : "not ok 31\n"); + +## for(;;) loop with a label + +TEST32: { # redo + + $ok = 0; + + LABEL32: for(my $first_time = 1; 1;) { + if (!$first_time) { + $ok = 1; + last TEST32; + } + $ok = 0; + $first_time=0; + + redo LABEL32; + last TEST32; + } + $ok = 0; +} +print ($ok ? "ok 32\n" : "not ok 32\n"); + +TEST33: { # next (successful) + + $ok = 0; + + LABEL33: for(my $first_time = 1; 1; $first_time=0) { + if (!$first_time) { + $ok = 1; + last TEST33; + } + $ok = 0; + next LABEL33; + last TEST33; + } + $ok = 0; +} +print ($ok ? "ok 33\n" : "not ok 33\n"); + +TEST34: { # next (unsuccesful) + + $ok = 0; + + my $x=1; + my $been_in_loop = 0; + LABEL34: for(my $first_time = 1; $x--;) { + $been_in_loop = 1; + if (!$first_time) { + $ok = 0; + last TEST34; + } + $ok = 0; + $first_time = 0; + next LABEL34; + last TEST34; + } + $ok = $been_in_loop; +} +print ($ok ? "ok 34\n" : "not ok 34\n"); + +TEST35: { # last + + $ok = 0; + + LABEL35: for(my $first_time = 1; 1; last TEST16) { + if (!$first_time) { + $ok = 0; + last TEST35; + } + $ok = 0; + $first_time = 0; + last LABEL35; + last TEST35; + } + $ok = 1; +} +print ($ok ? "ok 35\n" : "not ok 35\n"); + +## bare block with a label + +TEST36: { # redo + + $ok = 0; + my $first_time = 1; + + LABEL36: { + if (!$first_time) { + $ok = 1; + last TEST36; + } + $ok = 0; + $first_time=0; + + redo LABEL36; + last TEST36; + } + continue { + $ok = 0; + last TEST36; + } + $ok = 0; +} +print ($ok ? "ok 36\n" : "not ok 36\n"); + +TEST37: { # next + + $ok = 0; + LABEL37: { + next LABEL37; + last TEST37; + } + continue { + $ok = 1; + last TEST37; + } + $ok = 0; +} +print ($ok ? "ok 37\n" : "not ok 37\n"); + +TEST38: { # last + + $ok = 0; + LABEL38: { + last LABEL38; + last TEST38; + } + continue { + $ok = 0; + last TEST38; + } + $ok = 1; +} +print ($ok ? "ok 38\n" : "not ok 38\n"); + +### Now test nested constructs + +TEST39: { + $ok = 0; + my ($x, $y, $z) = (1,1,1); + one39: while ($x--) { + $ok = 0; + two39: while ($y--) { + $ok = 0; + three39: while ($z--) { + next two39; + } + continue { + $ok = 0; + last TEST39; + } + } + continue { + $ok = 1; + last TEST39; + } + $ok = 0; + } +} +print ($ok ? "ok 39\n" : "not ok 39\n"); ```
p5pRT commented 24 years ago

From [Unknown Contact. See original ticket]

Ton Hospel wrote​:

This sounds extremely simular to http​://bugs.perl.org/perlbug.cgi?req=bid&bid=20000313.004&range=10985&format=H&trim=25

Does it happen to fix that too ?

No\, that's a different bug! :-) Thanks for pointing it out.

Try the patch below\, which applies over the one I just posted.

.robin.

Inline Patch ```diff --- perl-robin/pp_ctl.c Tue Mar 13 16:02:46 2001 +++ perl-robin2/pp_ctl.c Wed Mar 14 01:41:37 2001 @@ -2463,8 +2463,11 @@ cx = &cxstack[ix]; switch (CxTYPE(cx)) { case CXt_EVAL: - gotoprobe = PL_eval_root; /* XXX not good for nested eval */ - break; + if (CxREALEVAL(cx)) { + gotoprobe = PL_eval_root; /* XXX not good for nested eval */ + break; + } + /* else fall through */ case CXt_LOOP: gotoprobe = cx->blk_oldcop->op_sibling; break; @@ -3506,7 +3509,6 @@ push_return(cLOGOP->op_other->op_next); PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), SP); PUSHEVAL(cx, 0, 0); - PL_eval_root = PL_op; /* Only needed so that goto works right. */ PL_in_eval = EVAL_INEVAL; sv_setpv(ERRSV,""); --- perl-robin/t/op/goto.t Wed Mar 14 00:31:42 2001 +++ perl-robin2/t/op/goto.t Wed Mar 14 01:51:32 2001 @@ -2,7 +2,7 @@ # "This IS structured code. It's just randomly structured." -print "1..19\n"; +print "1..21\n"; while ($?) { $foo = 1; @@ -105,6 +105,29 @@ ($y, $z) = ("not ok 19\n", 1); goto FORL2; } + +# Does goto work correctly within a try block? +# (BUG ID 20000313.004) + +my $ok = 0; +eval { + my $variable = 1; + goto LABEL20; + LABEL20: $ok = 1 if $variable; +}; +print ($ok&&!$@ ? "ok 20\n" : "not ok 20\n"); + +# And within an eval-string? + + +$ok = 0; +eval q{ + my $variable = 1; + goto LABEL21; + LABEL21: $ok = 1 if $variable; +}; +print ($ok&&!$@ ? "ok 21\n" : "not ok 21\n"); + exit; ```
p5pRT commented 24 years ago

From @jhi

On Wed\, Mar 14\, 2001 at 12​:43​:45AM +0000\, Robin Houston wrote​:

As Jarkko pointed out\, my last patch simply switched one kind of brokenness for a different (probably worse) one. Sorry.

Below is round two.

Thanks\, applied.

p5pRT commented 24 years ago

From @jhi

On Wed\, Mar 14\, 2001 at 01​:52​:51AM +0000\, Robin Houston wrote​:

Ton Hospel wrote​:

This sounds extremely simular to http​://bugs.perl.org/perlbug.cgi?req=bid&bid=20000313.004&range=10985&format=H&trim=25

Does it happen to fix that too ?

No\, that's a different bug! :-) Thanks for pointing it out.

Try the patch below\, which applies over the one I just posted.

Thanks\, applied.

p5pRT commented 24 years ago

From [Unknown Contact. See original ticket]

On Sat\, 10 Mar 2001\, Robin Houston wrote​:

Wow! This is a venerable bug\, dating at least back to 5.00404.

When a for(;;) is compiled\, there's no nextstate immediately before the enterloop\, and so when pp_goto does this​:

        case CXt\_LOOP&#8203;:
            gotoprobe = cx\->blk\_oldcop\->op\_sibling;
            break;

gotoprobe ends up pointing into a dead end.

--- perly.y.orig Fri Mar 9 23​:24​:30 2001 +++ perly.y Sat Mar 10 00​:19​:03 2001 @​@​ -249\,9 +249\,10 @​@​ /* basically fake up an initialize-while lineseq */

I think this is what made it in as change 9139(?). I am happy to report that perl@​9172 builds and passes about as many tests as the previous devel kit ("Failed 23 test scripts out of 309\, 92.56% okay.").

Thank you for cross-posting the perly.y diff to perl-mvs.

Peter Prymmer