1N/A#!./perl
1N/A
1N/A# "This IS structured code. It's just randomly structured."
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = qw(. ../lib);
1N/A}
1N/A
1N/Aprint "1..32\n";
1N/A
1N/Arequire "test.pl";
1N/A
1N/Awhile ($?) {
1N/A $foo = 1;
1N/A label1:
1N/A $foo = 2;
1N/A goto label2;
1N/A} continue {
1N/A $foo = 0;
1N/A goto label4;
1N/A label3:
1N/A $foo = 4;
1N/A goto label4;
1N/A}
1N/Agoto label1;
1N/A
1N/A$foo = 3;
1N/A
1N/Alabel2:
1N/Aprint "#1\t:$foo: == 2\n";
1N/Aif ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";}
1N/Agoto label3;
1N/A
1N/Alabel4:
1N/Aprint "#2\t:$foo: == 4\n";
1N/Aif ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
1N/A
1N/A$PERL = ($^O eq 'MSWin32') ? '.\perl' : ($^O eq 'MacOS') ? $^X : ($^O eq 'NetWare') ? 'perl' : './perl';
1N/A$CMD = qq[$PERL -e "goto foo;" 2>&1 ];
1N/A$x = `$CMD`;
1N/A
1N/Aif ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
1N/A
1N/Asub foo {
1N/A goto bar;
1N/A print "not ok 4\n";
1N/A return;
1N/Abar:
1N/A print "ok 4\n";
1N/A}
1N/A
1N/A&foo;
1N/A
1N/Asub bar {
1N/A $x = 'bypass';
1N/A eval "goto $x";
1N/A}
1N/A
1N/A&bar;
1N/Aexit;
1N/A
1N/AFINALE:
1N/Aprint "ok 13\n";
1N/A
1N/A# does goto LABEL handle block contexts correctly?
1N/A
1N/Amy $cond = 1;
1N/Afor (1) {
1N/A if ($cond == 1) {
1N/A $cond = 0;
1N/A goto OTHER;
1N/A }
1N/A elsif ($cond == 0) {
1N/A OTHER:
1N/A $cond = 2;
1N/A print "ok 14\n";
1N/A goto THIRD;
1N/A }
1N/A else {
1N/A THIRD:
1N/A print "ok 15\n";
1N/A }
1N/A}
1N/Aprint "ok 16\n";
1N/A
1N/A# Does goto work correctly within a for(;;) loop?
1N/A# (BUG ID 20010309.004)
1N/A
1N/Afor(my $i=0;!$i++;) {
1N/A my $x=1;
1N/A goto label;
1N/A label: print (defined $x?"ok ": "not ok ", "17\n")
1N/A}
1N/A
1N/A# Does goto work correctly going *to* a for(;;) loop?
1N/A# (make sure it doesn't skip the initializer)
1N/A
1N/Amy ($z, $y) = (0);
1N/AFORL1: for($y="ok 18\n"; $z;) {print $y; goto TEST19}
1N/A($y,$z) = ("not ok 18\n", 1);
1N/Agoto FORL1;
1N/A
1N/A# Even from within the loop?
1N/A
1N/ATEST19: $z = 0;
1N/AFORL2: for($y="ok 19\n"; 1;) {
1N/A if ($z) {
1N/A print $y;
1N/A last;
1N/A }
1N/A ($y, $z) = ("not ok 19\n", 1);
1N/A goto FORL2;
1N/A}
1N/A
1N/A# Does goto work correctly within a try block?
1N/A# (BUG ID 20000313.004)
1N/A
1N/Amy $ok = 0;
1N/Aeval {
1N/A my $variable = 1;
1N/A goto LABEL20;
1N/A LABEL20: $ok = 1 if $variable;
1N/A};
1N/Aprint ($ok&&!$@ ? "ok 20\n" : "not ok 20\n");
1N/A
1N/A# And within an eval-string?
1N/A
1N/A
1N/A$ok = 0;
1N/Aeval q{
1N/A my $variable = 1;
1N/A goto LABEL21;
1N/A LABEL21: $ok = 1 if $variable;
1N/A};
1N/Aprint ($ok&&!$@ ? "ok 21\n" : "not ok 21\n");
1N/A
1N/A
1N/A# Test that goto works in nested eval-string
1N/A$ok = 0;
1N/A{eval q{
1N/A eval q{
1N/A goto LABEL22;
1N/A };
1N/A $ok = 0;
1N/A last;
1N/A
1N/A LABEL22: $ok = 1;
1N/A};
1N/A$ok = 0 if $@;
1N/A}
1N/Aprint ($ok ? "ok 22\n" : "not ok 22\n");
1N/A
1N/A{
1N/A my $false = 0;
1N/A
1N/A $ok = 0;
1N/A { goto A; A: $ok = 1 } continue { }
1N/A print "not " unless $ok;
1N/A print "ok 23 - #20357 goto inside /{ } continue { }/ loop\n";
1N/A
1N/A $ok = 0;
1N/A { do { goto A; A: $ok = 1 } while $false }
1N/A print "not " unless $ok;
1N/A print "ok 24 - #20154 goto inside /do { } while ()/ loop\n";
1N/A
1N/A $ok = 0;
1N/A foreach(1) { goto A; A: $ok = 1 } continue { };
1N/A print "not " unless $ok;
1N/A print "ok 25 - goto inside /foreach () { } continue { }/ loop\n";
1N/A
1N/A $ok = 0;
1N/A sub a {
1N/A A: { if ($false) { redo A; B: $ok = 1; redo A; } }
1N/A goto B unless $r++
1N/A }
1N/A a();
1N/A print "not " unless $ok;
1N/A print "ok 26 - #19061 loop label wiped away by goto\n";
1N/A
1N/A $ok = 0;
1N/A for ($p=1;$p && goto A;$p=0) { A: $ok = 1 }
1N/A print "not " unless $ok;
1N/A print "ok 27 - weird case of goto and for(;;) loop\n";
1N/A}
1N/A
1N/A# bug #9990 - don't prematurely free the CV we're &going to.
1N/A
1N/Asub f1 {
1N/A my $x;
1N/A goto sub { $x; print "ok 28 - don't prematurely free CV\n" }
1N/A}
1N/Af1();
1N/A
1N/A# bug #22181 - this used to coredump or make $x undefined, due to
1N/A# erroneous popping of the inner BLOCK context
1N/A
1N/Afor ($i=0; $i<2; $i++) {
1N/A my $x = 1;
1N/A goto LABEL29;
1N/A LABEL29:
1N/A print "not " if !defined $x || $x != 1;
1N/A}
1N/Aprint "ok 29 - goto in for(;;) with continuation\n";
1N/A
1N/A# bug #22299 - goto in require doesn't find label
1N/A
1N/Aopen my $f, ">goto01.pm" or die;
1N/Aprint $f <<'EOT';
1N/Apackage goto01;
1N/Agoto YYY;
1N/Adie;
1N/AYYY: print "OK\n";
1N/A1;
1N/AEOT
1N/Aclose $f;
1N/A
1N/Acurr_test(30);
1N/Amy $r = runperl(prog => 'use goto01; print qq[DONE\n]');
1N/Ais($r, "OK\nDONE\n", "goto within use-d file");
1N/Aunlink "goto01.pm";
1N/A
1N/A# test for [perl #24108]
1N/Asub i_return_a_label {
1N/A print "ok 31 - i_return_a_label called\n";
1N/A return "returned_label";
1N/A}
1N/Aeval { goto +i_return_a_label; };
1N/Aprint "not ";
1N/Areturned_label : print "ok 32 - done to returned_label\n";
1N/A
1N/Aexit;
1N/A
1N/Abypass:
1N/Aprint "ok 5\n";
1N/A
1N/A# Test autoloading mechanism.
1N/A
1N/Asub two {
1N/A ($pack, $file, $line) = caller; # Should indicate original call stats.
1N/A print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
1N/A ? "ok 7\n"
1N/A : "not ok 7\n";
1N/A}
1N/A
1N/Asub one {
1N/A eval <<'END';
1N/A sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
1N/AEND
1N/A goto &one;
1N/A}
1N/A
1N/A$FILE = __FILE__;
1N/A$LINE = __LINE__ + 1;
1N/A&one(1,2,3);
1N/A
1N/A$wherever = NOWHERE;
1N/Aeval { goto $wherever };
1N/Aprint $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
1N/A
1N/A# see if a modified @_ propagates
1N/A{
1N/A package Foo;
1N/A sub DESTROY { my $s = shift; print "ok $s->[0]\n"; }
1N/A sub show { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
1N/A sub start { push @_, 1, "foo", {}; goto &show; }
1N/A for (9..11) { start(bless([$_]), 'bar'); }
1N/A}
1N/A
1N/Asub auto {
1N/A goto &loadit;
1N/A}
1N/A
1N/Asub AUTOLOAD { print @_ }
1N/A
1N/Aauto("ok 12\n");
1N/A
1N/A$wherever = FINALE;
1N/Agoto $wherever;