Linux cpanel2.daytoncreative.net 2.6.32-754.29.2.el6.x86_64 #1 SMP Tue May 12 17:39:04 UTC 2020 x86_64
Apache/2.4.43 (cPanel) OpenSSL/1.1.1g mod_bwlimited/1.4
Server IP : 70.62.220.67 & Your IP : 216.73.216.193
Domains :
Cant Read [ /etc/named.conf ]
User : michaelgreg
Terminal
Auto Root
Create File
Create Folder
Localroot Suggester
Backdoor Destroyer
Readme
/
var /
log /
perl-5.20.2 /
t /
op /
Delete
Unzip
Name
Size
Permission
Date
Action
64bitint.t
8.14
KB
-r--r--r--
2014-12-27 11:49
alarm.t
1.5
KB
-r--r--r--
2014-12-27 11:49
anonsub.t
1.7
KB
-r--r--r--
2014-12-27 11:49
append.t
1.58
KB
-r--r--r--
2014-12-27 11:49
args.t
2.12
KB
-r--r--r--
2014-12-27 11:49
array.t
12.32
KB
-r--r--r--
2014-12-27 11:49
array_base.t
720
B
-r--r--r--
2014-12-27 11:49
assignwarn.t
1.52
KB
-r--r--r--
2014-12-27 11:49
attrhand.t
1.01
KB
-r--r--r--
2014-12-27 11:49
attrproto.t
6.55
KB
-r--r--r--
2014-12-27 11:49
attrs.t
10.73
KB
-r--r--r--
2014-12-27 11:49
auto.t
2.36
KB
-r--r--r--
2014-12-27 11:49
avhv.t
4.04
KB
-r--r--r--
2014-12-27 11:49
bless.t
4.12
KB
-r--r--r--
2014-12-27 11:49
blocks.t
2.95
KB
-r--r--r--
2014-12-27 11:49
bop.t
12.82
KB
-r--r--r--
2014-12-27 11:49
caller.pl
3.75
KB
-r--r--r--
2014-12-27 11:49
caller.t
8.14
KB
-r--r--r--
2014-12-27 11:49
chars.t
1.73
KB
-r--r--r--
2014-12-27 11:49
chdir.t
6.68
KB
-r--r--r--
2014-12-27 11:49
chop.t
7.67
KB
-r--r--r--
2014-12-27 11:49
chr.t
2.48
KB
-r--r--r--
2014-12-27 11:49
closure.t
19.6
KB
-r--r--r--
2014-12-27 11:49
closure_test.pl
327
B
-r--r--r--
2014-12-27 11:49
concat2.t
1.41
KB
-r--r--r--
2014-12-27 11:49
cond.t
282
B
-r--r--r--
2014-12-27 11:49
context.t
404
B
-r--r--r--
2014-12-27 11:49
coreamp.t
29.17
KB
-r--r--r--
2014-12-27 11:49
coresubs.t
4.87
KB
-r--r--r--
2014-12-27 11:49
cproto.t
3.6
KB
-r--r--r--
2014-12-27 11:49
crypt.t
1.17
KB
-r--r--r--
2014-12-27 11:49
current_sub.t
1.71
KB
-r--r--r--
2014-12-27 11:49
dbm.t
1.54
KB
-r--r--r--
2014-12-27 11:49
defined.t
551
B
-r--r--r--
2014-12-27 11:49
defins.t
4.84
KB
-r--r--r--
2014-12-27 11:49
delete.t
2.93
KB
-r--r--r--
2014-12-27 11:49
die.t
1.99
KB
-r--r--r--
2014-12-27 11:49
die_except.t
1.57
KB
-r--r--r--
2014-12-27 11:49
die_exit.t
1.9
KB
-r--r--r--
2014-12-27 11:49
die_keeperr.t
1.57
KB
-r--r--r--
2014-12-27 11:49
die_unwind.t
1.69
KB
-r--r--r--
2014-12-27 11:49
do.t
8.35
KB
-r--r--r--
2014-12-27 11:49
dor.t
2.64
KB
-r--r--r--
2014-12-27 11:49
each.t
7.09
KB
-r--r--r--
2014-12-27 11:49
each_array.t
5.48
KB
-r--r--r--
2014-12-27 11:49
eval.t
13.92
KB
-r--r--r--
2014-12-27 11:49
evalbytes.t
989
B
-r--r--r--
2014-12-27 11:49
exec.t
4.36
KB
-r--r--r--
2014-12-27 11:49
exists_sub.t
2.09
KB
-r--r--r--
2014-12-27 11:49
exp.t
1.47
KB
-r--r--r--
2014-12-27 11:49
fh.t
790
B
-r--r--r--
2014-12-27 11:49
filehandle.t
564
B
-r--r--r--
2014-12-27 11:49
filetest.t
11.97
KB
-r--r--r--
2014-12-27 11:49
filetest_stack_ok.t
1.12
KB
-r--r--r--
2014-12-27 11:49
filetest_t.t
1.18
KB
-r--r--r--
2014-12-27 11:49
flip.t
868
B
-r--r--r--
2014-12-27 11:49
for.t
12.77
KB
-r--r--r--
2014-12-27 11:49
fork.t
8.8
KB
-r--r--r--
2014-12-27 11:49
fresh_perl_utf8.t
411
B
-r--r--r--
2014-12-27 11:49
getpid.t
1.61
KB
-r--r--r--
2014-12-27 11:49
getppid.t
3.13
KB
-r--r--r--
2014-12-27 11:49
glob.t
4.22
KB
-r--r--r--
2014-12-27 11:49
gmagic.t
5.97
KB
-r--r--r--
2014-12-27 11:49
goto.t
14.85
KB
-r--r--r--
2014-12-27 11:49
goto_xs.t
2.98
KB
-r--r--r--
2014-12-27 11:49
grent.t
4.46
KB
-r--r--r--
2014-12-27 11:49
grep.t
6.66
KB
-r--r--r--
2014-12-27 11:49
groups.t
11.15
KB
-r--r--r--
2014-12-27 11:49
gv.t
30.15
KB
-r--r--r--
2014-12-27 11:49
hash-rt85026.t
1.57
KB
-r--r--r--
2014-12-27 11:49
hash.t
6.02
KB
-r--r--r--
2014-12-27 11:49
hashassign.t
18.85
KB
-r--r--r--
2014-12-27 11:49
hashwarn.t
2.05
KB
-r--r--r--
2014-12-27 11:49
heredoc.t
2.29
KB
-r--r--r--
2014-12-27 11:49
inc.t
6.72
KB
-r--r--r--
2014-12-27 11:49
inccode-tie.t
338
B
-r--r--r--
2014-12-27 11:49
inccode.t
11.19
KB
-r--r--r--
2014-12-27 11:49
incfilter.t
7.33
KB
-r--r--r--
2014-12-27 11:49
index.t
6.81
KB
-r--r--r--
2014-12-27 11:49
index_thr.t
56
B
-r--r--r--
2014-12-27 11:49
int.t
1.72
KB
-r--r--r--
2014-12-27 11:49
join.t
3.2
KB
-r--r--r--
2014-12-27 11:49
kill0.t
3.18
KB
-r--r--r--
2014-12-27 11:49
kill0_child
596
B
-r--r--r--
2014-12-27 11:49
kvaslice.t
4.66
KB
-r--r--r--
2014-12-27 11:49
kvhslice.t
5.44
KB
-r--r--r--
2014-12-27 11:49
lc.t
11.8
KB
-r--r--r--
2014-12-27 11:49
leaky-magic.t
3.43
KB
-r--r--r--
2014-12-27 11:49
length.t
5.03
KB
-r--r--r--
2014-12-27 11:49
lex.t
2.33
KB
-r--r--r--
2014-12-27 11:49
lex_assign.t
7.17
KB
-r--r--r--
2014-12-27 11:49
lexsub.t
19.62
KB
-r--r--r--
2014-12-27 12:24
lfs.t
6.2
KB
-r--r--r--
2014-12-27 11:49
list.t
5.31
KB
-r--r--r--
2014-12-27 11:52
local.t
17.11
KB
-r--r--r--
2014-12-27 11:49
localref.t
2.73
KB
-r--r--r--
2014-12-27 11:49
lock.t
465
B
-r--r--r--
2014-12-27 11:49
loopctl.t
17.88
KB
-r--r--r--
2014-12-27 11:49
lop.t
1.2
KB
-r--r--r--
2014-12-27 11:49
magic-27839.t
622
B
-r--r--r--
2014-12-27 11:49
magic.t
21.81
KB
-r--r--r--
2014-12-27 11:49
method.t
18.91
KB
-r--r--r--
2014-12-27 11:49
mkdir.t
1.25
KB
-r--r--r--
2014-12-27 11:49
my.t
4.29
KB
-r--r--r--
2014-12-27 11:49
my_stash.t
769
B
-r--r--r--
2014-12-27 11:49
mydef.t
5.51
KB
-r--r--r--
2014-12-27 11:49
negate.t
4.3
KB
-r--r--r--
2014-12-27 11:49
not.t
3.15
KB
-r--r--r--
2014-12-27 11:49
numconvert.t
8.33
KB
-r--r--r--
2014-12-27 11:49
oct.t
3.58
KB
-r--r--r--
2014-12-27 11:49
or.t
1.79
KB
-r--r--r--
2014-12-27 11:49
ord.t
2.48
KB
-r--r--r--
2014-12-27 11:49
overload_integer.t
506
B
-r--r--r--
2014-12-27 11:49
override.t
4.33
KB
-r--r--r--
2014-12-27 11:49
pack.t
65.34
KB
-r--r--r--
2014-12-27 11:49
packagev.t
5.97
KB
-r--r--r--
2014-12-27 11:49
pos.t
3.59
KB
-r--r--r--
2014-12-27 11:49
postfixderef.t
11.97
KB
-r--r--r--
2014-12-27 11:49
pow.t
2.34
KB
-r--r--r--
2014-12-27 11:49
print.t
692
B
-r--r--r--
2014-12-27 11:49
protowarn.t
1.35
KB
-r--r--r--
2014-12-27 11:49
push.t
3.03
KB
-r--r--r--
2014-12-27 11:49
pwent.t
6.63
KB
-r--r--r--
2014-12-27 11:49
qr.t
2.32
KB
-r--r--r--
2014-12-27 11:49
quotemeta.t
5.61
KB
-r--r--r--
2014-12-27 11:49
rand.t
8.31
KB
-r--r--r--
2014-12-27 11:49
range.t
9.25
KB
-r--r--r--
2014-12-27 11:49
read.t
2.28
KB
-r--r--r--
2014-12-27 11:49
readdir.t
2.09
KB
-r--r--r--
2014-12-27 11:49
readline.t
7.19
KB
-r--r--r--
2014-12-27 11:49
recurse.t
2.73
KB
-r--r--r--
2014-12-27 11:49
ref.t
22.74
KB
-r--r--r--
2014-12-27 11:49
repeat.t
4.8
KB
-r--r--r--
2014-12-27 11:49
require_37033.t
1.18
KB
-r--r--r--
2014-12-27 11:49
require_errors.t
3.68
KB
-r--r--r--
2014-12-27 11:49
reset.t
5.41
KB
-r--r--r--
2014-12-27 11:49
reverse.t
3.01
KB
-r--r--r--
2014-12-27 11:49
rt119311.t
5.58
KB
-r--r--r--
2014-12-27 11:49
runlevel.t
5.28
KB
-r--r--r--
2014-12-27 11:49
select.t
1.03
KB
-r--r--r--
2014-12-27 11:49
setpgrpstack.t
378
B
-r--r--r--
2014-12-27 11:49
sigdispatch.t
4.33
KB
-r--r--r--
2014-12-27 11:49
signatures.t
41.02
KB
-r--r--r--
2014-12-27 11:49
sigsystem.t
1.36
KB
-r--r--r--
2014-12-27 11:49
sleep.t
468
B
-r--r--r--
2014-12-27 11:49
smartkve.t
18.26
KB
-r--r--r--
2014-12-27 11:49
smartmatch.t
10.34
KB
-r--r--r--
2014-12-27 11:49
sort.t
28.4
KB
-r--r--r--
2015-01-10 13:17
splice.t
3.38
KB
-r--r--r--
2014-12-27 11:49
split.t
13.1
KB
-r--r--r--
2014-12-27 11:49
split_unicode.t
2.4
KB
-r--r--r--
2014-12-27 11:49
sprintf.t
28.5
KB
-r--r--r--
2014-12-27 11:49
sprintf2.t
5.49
KB
-r--r--r--
2014-12-27 11:49
srand.t
1.87
KB
-r--r--r--
2014-12-27 11:49
sselect.t
2.67
KB
-r--r--r--
2014-12-27 11:49
stash.t
9.01
KB
-r--r--r--
2014-12-27 11:49
stat.t
17.51
KB
-r--r--r--
2014-12-27 11:49
state.t
9.72
KB
-r--r--r--
2014-12-27 12:15
study.t
2.99
KB
-r--r--r--
2014-12-27 11:49
studytied.t
1.29
KB
-r--r--r--
2014-12-27 11:49
sub.t
6.54
KB
-r--r--r--
2014-12-27 11:49
sub_lval.t
24.2
KB
-r--r--r--
2014-12-27 11:49
substr.t
20.53
KB
-r--r--r--
2014-12-27 11:49
substr_thr.t
56
B
-r--r--r--
2014-12-27 11:49
svleak.pl
6
B
-r--r--r--
2014-12-27 11:49
svleak.t
15.93
KB
-r--r--r--
2015-01-10 12:06
switch.t
28.06
KB
-r--r--r--
2014-12-27 11:49
symbolcache.t
1.06
KB
-r--r--r--
2014-12-27 11:49
sysio.t
5
KB
-r--r--r--
2014-12-27 11:49
taint.t
66.84
KB
-r--r--r--
2014-12-27 12:32
threads-dirh.t
3.47
KB
-r--r--r--
2014-12-27 11:49
threads.t
9.3
KB
-r--r--r--
2014-12-27 11:49
threads_create.pl
42
B
-r--r--r--
2014-12-27 11:49
tie.t
28.34
KB
-r--r--r--
2014-12-27 11:49
tie_fetch_count.t
11.49
KB
-r--r--r--
2014-12-27 11:49
tiearray.t
4.53
KB
-r--r--r--
2014-12-27 11:49
tiehandle.t
5.27
KB
-r--r--r--
2014-12-27 11:49
time.t
7.86
KB
-r--r--r--
2015-01-17 11:51
time_loop.t
378
B
-r--r--r--
2014-12-27 11:49
tr.t
12.99
KB
-r--r--r--
2014-12-27 11:49
undef.t
3.15
KB
-r--r--r--
2014-12-27 11:49
universal.t
8.32
KB
-r--r--r--
2014-12-27 11:49
unlink.t
1.02
KB
-r--r--r--
2014-12-27 11:49
unshift.t
3.17
KB
-r--r--r--
2014-12-27 11:49
upgrade.t
1.15
KB
-r--r--r--
2014-12-27 11:49
utf8cache.t
3.83
KB
-r--r--r--
2014-12-27 11:49
utf8decode.t
7.59
KB
-r--r--r--
2014-12-27 11:49
utf8magic.t
808
B
-r--r--r--
2014-12-27 11:49
utfhash.t
5.33
KB
-r--r--r--
2014-12-27 11:49
utftaint.t
4.46
KB
-r--r--r--
2014-12-27 11:49
vec.t
2.87
KB
-r--r--r--
2014-12-27 11:49
ver.t
8.39
KB
-r--r--r--
2014-12-27 11:49
waitpid.t
973
B
-r--r--r--
2014-12-27 11:49
wantarray.t
874
B
-r--r--r--
2014-12-27 11:49
warn.t
4.15
KB
-r--r--r--
2014-12-27 11:49
while.t
3.81
KB
-r--r--r--
2014-12-27 11:49
write.t
39.99
KB
-r--r--r--
2015-01-24 15:03
yadayada.t
1.67
KB
-r--r--r--
2015-01-15 22:12
Save
Rename
#!./perl # "This IS structured code. It's just randomly structured." BEGIN { chdir 't' if -d 't'; @INC = qw(. ../lib); require "test.pl"; } use warnings; use strict; plan tests => 94; our $TODO; my $deprecated = 0; local $SIG{__WARN__} = sub { if ($_[0] =~ m/jump into a construct/) { $deprecated++; } else { warn $_[0] } }; our $foo; while ($?) { $foo = 1; label1: is($deprecated, 1, "following label1"); $deprecated = 0; $foo = 2; goto label2; } continue { $foo = 0; goto label4; label3: is($deprecated, 1, "following label3"); $deprecated = 0; $foo = 4; goto label4; } is($deprecated, 0, "after 'while' loop"); goto label1; $foo = 3; label2: is($foo, 2, 'escape while loop'); is($deprecated, 0, "following label2"); goto label3; label4: is($foo, 4, 'second escape while loop'); my $r = run_perl(prog => 'goto foo;', stderr => 1); like($r, qr/label/, 'cant find label'); my $ok = 0; sub foo { goto bar; return; bar: $ok = 1; } &foo; ok($ok, 'goto in sub'); sub bar { my $x = 'bypass'; eval "goto $x"; } &bar; exit; FINALE: is(curr_test(), 20, 'FINALE'); # does goto LABEL handle block contexts correctly? # note that this scope-hopping differs from last & next, # which always go up-scope strictly. my $count = 0; my $cond = 1; for (1) { if ($cond == 1) { $cond = 0; goto OTHER; } elsif ($cond == 0) { OTHER: $cond = 2; is($count, 0, 'OTHER'); $count++; goto THIRD; } else { THIRD: is($count, 1, 'THIRD'); $count++; } } is($count, 2, 'end of loop'); # Does goto work correctly within a for(;;) loop? # (BUG ID 20010309.004) for(my $i=0;!$i++;) { my $x=1; goto label; label: is($x, 1, 'goto inside a for(;;) loop body from inside the body'); } # Does goto work correctly going *to* a for(;;) loop? # (make sure it doesn't skip the initializer) my ($z, $y) = (0); FORL1: for ($y=1; $z;) { ok($y, 'goto a for(;;) loop, from outside (does initializer)'); goto TEST19} ($y,$z) = (0, 1); goto FORL1; # Even from within the loop? TEST19: $z = 0; FORL2: for($y=1; 1;) { if ($z) { ok($y, 'goto a for(;;) loop, from inside (does initializer)'); last; } ($y, $z) = (0, 1); goto FORL2; } # Does goto work correctly within a try block? # (BUG ID 20000313.004) - [perl #2359] $ok = 0; eval { my $variable = 1; goto LABEL20; LABEL20: $ok = 1 if $variable; }; ok($ok, 'works correctly within a try block'); is($@, "", '...and $@ not set'); # And within an eval-string? $ok = 0; eval q{ my $variable = 1; goto LABEL21; LABEL21: $ok = 1 if $variable; }; ok($ok, 'works correctly within an eval string'); is($@, "", '...and $@ still not set'); # Test that goto works in nested eval-string $ok = 0; {eval q{ eval q{ goto LABEL22; }; $ok = 0; last; LABEL22: $ok = 1; }; $ok = 0 if $@; } ok($ok, 'works correctly in a nested eval string'); { my $false = 0; my $count; $ok = 0; { goto A; A: $ok = 1 } continue { } ok($ok, '#20357 goto inside /{ } continue { }/ loop'); $ok = 0; { do { goto A; A: $ok = 1 } while $false } ok($ok, '#20154 goto inside /do { } while ()/ loop'); $ok = 0; foreach(1) { goto A; A: $ok = 1 } continue { }; ok($ok, 'goto inside /foreach () { } continue { }/ loop'); $ok = 0; sub a { A: { if ($false) { redo A; B: $ok = 1; redo A; } } goto B unless $count++; } is($deprecated, 0, "before calling sub a()"); a(); ok($ok, '#19061 loop label wiped away by goto'); is($deprecated, 1, "after calling sub a()"); $deprecated = 0; $ok = 0; my $p; for ($p=1;$p && goto A;$p=0) { A: $ok = 1 } ok($ok, 'weird case of goto and for(;;) loop'); is($deprecated, 1, "following goto and for(;;) loop"); $deprecated = 0; } # bug #9990 - don't prematurely free the CV we're &going to. sub f1 { my $x; goto sub { $x=0; ok(1,"don't prematurely free CV\n") } } f1(); # bug #99850, which is similar - freeing the subroutine we are about to # go(in)to during a FREETMPS call should not crash perl. package _99850 { sub reftype{} DESTROY { undef &reftype } eval { sub { my $guard = bless []; goto &reftype }->() }; } like $@, qr/^Goto undefined subroutine &_99850::reftype at /, 'goto &foo undefining &foo on sub cleanup'; # bug #22181 - this used to coredump or make $x undefined, due to # erroneous popping of the inner BLOCK context undef $ok; for ($count=0; $count<2; $count++) { my $x = 1; goto LABEL29; LABEL29: $ok = $x; } is($ok, 1, 'goto in for(;;) with continuation'); # bug #22299 - goto in require doesn't find label open my $f, ">Op_goto01.pm" or die; print $f <<'EOT'; package goto01; goto YYY; die; YYY: print "OK\n"; 1; EOT close $f; $r = runperl(prog => 'use Op_goto01; print qq[DONE\n]'); is($r, "OK\nDONE\n", "goto within use-d file"); unlink_all "Op_goto01.pm"; # test for [perl #24108] $ok = 1; $count = 0; sub i_return_a_label { $count++; return "returned_label"; } eval { goto +i_return_a_label; }; $ok = 0; returned_label: is($count, 1, 'called i_return_a_label'); ok($ok, 'skipped to returned_label'); # [perl #29708] - goto &foo could leave foo() at depth two with # @_ == PL_sv_undef, causing a coredump $r = runperl( prog => 'sub f { return if $d; $d=1; my $a=sub {goto &f}; &$a; f() } f(); print qq(ok\n)', stderr => 1 ); is($r, "ok\n", 'avoid pad without an @_'); goto moretests; fail('goto moretests'); exit; bypass: is(curr_test(), 9, 'eval "goto $x"'); # Test autoloading mechanism. sub two { my ($pack, $file, $line) = caller; # Should indicate original call stats. is("@_ $pack $file $line", "1 2 3 main $::FILE $::LINE", 'autoloading mechanism.'); } sub one { eval <<'END'; no warnings 'redefine'; sub one { pass('sub one'); goto &two; fail('sub one tail'); } END goto &one; } $::FILE = __FILE__; $::LINE = __LINE__ + 1; &one(1,2,3); { my $wherever = 'NOWHERE'; eval { goto $wherever }; like($@, qr/Can't find label NOWHERE/, 'goto NOWHERE sets $@'); } # see if a modified @_ propagates { my $i; package Foo; sub DESTROY { my $s = shift; ::is($s->[0], $i, "destroy $i"); } sub show { ::is(+@_, 5, "show $i",); } sub start { push @_, 1, "foo", {}; goto &show; } for (1..3) { $i = $_; start(bless([$_]), 'bar'); } } sub auto { goto &loadit; } sub AUTOLOAD { $ok = 1 if "@_" eq "foo" } $ok = 0; auto("foo"); ok($ok, 'autoload'); { my $wherever = 'FINALE'; goto $wherever; } fail('goto $wherever'); moretests: # test goto duplicated labels. { my $z = 0; eval { $z = 0; for (0..1) { L4: # not outer scope $z += 10; last; } goto L4 if $z == 10; last; }; like($@, qr/Can't "goto" into the middle of a foreach loop/, 'catch goto middle of foreach'); $z = 0; # ambiguous label resolution (outer scope means endless loop!) L1: for my $x (0..1) { $z += 10; is($z, 10, 'prefer same scope (loop body) to outer scope (loop entry)'); goto L1 unless $x; $z += 10; L1: is($z, 10, 'prefer same scope: second'); last; } $z = 0; L2: { $z += 10; is($z, 10, 'prefer this scope (block body) to outer scope (block entry)'); goto L2 if $z == 10; $z += 10; L2: is($z, 10, 'prefer this scope: second'); } { $z = 0; while (1) { L3: # not inner scope $z += 10; last; } is($z, 10, 'prefer this scope to inner scope'); goto L3 if $z == 10; $z += 10; L3: # this scope ! is($z, 10, 'prefer this scope to inner scope: second'); } L4: # not outer scope { $z = 0; while (1) { L4: # not inner scope $z += 1; last; } is($z, 1, 'prefer this scope to inner,outer scopes'); goto L4 if $z == 1; $z += 10; L4: # this scope ! is($z, 1, 'prefer this scope to inner,outer scopes: second'); } { my $loop = 0; for my $x (0..1) { L2: # without this, fails 1 (middle) out of 3 iterations $z = 0; L2: $z += 10; is($z, 10, "same label, multiple times in same scope (choose 1st) $loop"); goto L2 if $z == 10 and not $loop++; } } } # deep recursion with gotos eventually caused a stack reallocation # which messed up buggy internals that didn't expect the stack to move sub recurse1 { unshift @_, "x"; no warnings 'recursion'; goto &recurse2; } sub recurse2 { my $x = shift; $_[0] ? +1 + recurse1($_[0] - 1) : 0 } my $w = 0; $SIG{__WARN__} = sub { ++$w }; is(recurse1(500), 500, 'recursive goto &foo'); is $w, 0, 'no recursion warnings for "no warnings; goto &sub"'; delete $SIG{__WARN__}; # [perl #32039] Chained goto &sub drops data too early. sub a32039 { @_=("foo"); goto &b32039; } sub b32039 { goto &c32039; } sub c32039 { is($_[0], 'foo', 'chained &goto') } a32039(); # [perl #35214] next and redo re-entered the loop with the wrong cop, # causing a subsequent goto to crash { my $r = runperl( stderr => 1, prog => 'for ($_=0;$_<3;$_++){A: if($_==1){next} if($_==2){$_++;goto A}}print qq(ok\n)' ); is($r, "ok\n", 'next and goto'); $r = runperl( stderr => 1, prog => 'for ($_=0;$_<3;$_++){A: if($_==1){$_++;redo} if($_==2){$_++;goto A}}print qq(ok\n)' ); is($r, "ok\n", 'redo and goto'); } # goto &foo not allowed in evals sub null { 1 }; eval 'goto &null'; like($@, qr/Can't goto subroutine from an eval-string/, 'eval string'); eval { goto &null }; like($@, qr/Can't goto subroutine from an eval-block/, 'eval block'); # goto &foo leaves @_ alone when called from a sub sub returnarg { $_[0] }; is sub { local *_ = ["ick and queasy"]; goto &returnarg; }->("quick and easy"), "ick and queasy", 'goto &foo with *_{ARRAY} replaced'; my @__ = "\xc4\x80"; sub { local *_ = \@__; goto &utf8::decode }->("no thinking aloud"); is "@__", chr 256, 'goto &xsub with replaced *_{ARRAY}'; # And goto &foo should leave reified @_ alone sub { *__ = \@_; goto &null } -> ("rough and tubbery"); is ${*__}[0], 'rough and tubbery', 'goto &foo leaves reified @_ alone'; # goto &xsub when @_ has nonexistent elements { no warnings "uninitialized"; local @_ = (); $#_++; & {sub { goto &utf8::encode }}; is @_, 1, 'num of elems in @_ after goto &xsub with nonexistent $_[0]'; is $_[0], "", 'content of nonexistent $_[0] is modified by goto &xsub'; } # goto &xsub when @_ itself does not exist undef *_; eval { & { sub { goto &utf8::encode } } }; # The main thing we are testing is that it did not crash. But make sure # *_{ARRAY} was untouched, too. is *_{ARRAY}, undef, 'goto &xsub when @_ does not exist'; # goto &perlsub when @_ itself does not exist [perl #119949] # This was only crashing when the replaced sub call had an argument list. # (I.e., &{ sub { goto ... } } did not crash.) sub { undef *_; goto sub { is *_{ARRAY}, undef, 'goto &perlsub when @_ does not exist'; } }->(); sub { local *_; goto sub { is *_{ARRAY}, undef, 'goto &sub when @_ does not exist (local *_)'; } }->(); # [perl #36521] goto &foo in warn handler could defeat recursion avoider { my $r = runperl( stderr => 1, prog => 'my $d; my $w = sub { return if $d++; warn q(bar)}; local $SIG{__WARN__} = sub { goto &$w; }; warn q(foo);' ); like($r, qr/bar/, "goto &foo in warn"); } TODO: { local $TODO = "[perl #43403] goto() from an if to an else doesn't undo local () changes"; our $global = "unmodified"; if ($global) { # true but not constant-folded local $global = "modified"; goto ELSE; } else { ELSE: is($global, "unmodified"); } } is($deprecated, 0, "following TODOed test for #43403"); #74290 { my $x; my $y; F1:++$x and eval 'return if ++$y == 10; goto F1;'; is($x, 10, 'labels outside evals can be distinguished from the start of the eval'); } goto wham_eth; die "You can't get here"; wham_eth: 1 if 0; ouch_eth: pass('labels persist even if their statement is optimised away'); $foo = "(0)"; if($foo eq $foo) { goto bungo; } $foo .= "(9)"; bungo: format CHOLET = wellington . $foo .= "(1)"; SKIP: { skip_if_miniperl("no dynamic loading on miniperl, so can't load PerlIO::scalar", 1); my $cholet; open(CHOLET, ">", \$cholet); write CHOLET; close CHOLET; $foo .= "(".$cholet.")"; is($foo, "(0)(1)(wellington\n)", "label before format decl"); } $foo = "(A)"; if($foo eq $foo) { goto orinoco; } $foo .= "(X)"; orinoco: sub alderney { return "tobermory"; } $foo .= "(B)"; $foo .= "(".alderney().")"; is($foo, "(A)(B)(tobermory)", "label before sub decl"); $foo = "[0:".__PACKAGE__."]"; if($foo eq $foo) { goto bulgaria; } $foo .= "[9]"; bulgaria: package Tomsk; $foo .= "[1:".__PACKAGE__."]"; $foo .= "[2:".__PACKAGE__."]"; package main; $foo .= "[3:".__PACKAGE__."]"; is($foo, "[0:main][1:Tomsk][2:Tomsk][3:main]", "label before package decl"); $foo = "[A:".__PACKAGE__."]"; if($foo eq $foo) { goto adelaide; } $foo .= "[Z]"; adelaide: package Cairngorm { $foo .= "[B:".__PACKAGE__."]"; } $foo .= "[C:".__PACKAGE__."]"; is($foo, "[A:main][B:Cairngorm][C:main]", "label before package block"); our $obidos; $foo = "{0}"; if($foo eq $foo) { goto shansi; } $foo .= "{9}"; shansi: BEGIN { $obidos = "x"; } $foo .= "{1$obidos}"; is($foo, "{0}{1x}", "label before BEGIN block"); $foo = "{A:".(1.5+1.5)."}"; if($foo eq $foo) { goto stepney; } $foo .= "{Z}"; stepney: use integer; $foo .= "{B:".(1.5+1.5)."}"; is($foo, "{A:3}{B:2}", "label before use decl"); $foo = "<0>"; if($foo eq $foo) { goto tom; } $foo .= "<9>"; tom: dick: harry: $foo .= "<1>"; $foo .= "<2>"; is($foo, "<0><1><2>", "first of three stacked labels"); $foo = "<A>"; if($foo eq $foo) { goto beta; } $foo .= "<Z>"; alpha: beta: gamma: $foo .= "<B>"; $foo .= "<C>"; is($foo, "<A><B><C>", "second of three stacked labels"); $foo = ",0."; if($foo eq $foo) { goto gimel; } $foo .= ",9."; alef: bet: gimel: $foo .= ",1."; $foo .= ",2."; is($foo, ",0.,1.,2.", "third of three stacked labels"); # [perl #112316] Wrong behavior regarding labels with same prefix sub same_prefix_labels { my $pass; my $first_time = 1; CATCH: { if ( $first_time ) { CATCHLOOP: { if ( !$first_time ) { return 0; } $first_time--; goto CATCH; } } else { return 1; } } } ok( same_prefix_labels(), "perl 112316: goto and labels with the same prefix doesn't get mixed up" ); eval { my $x = ""; goto $x }; like $@, qr/^goto must have label at /, 'goto $x where $x is empty string'; eval { goto "" }; like $@, qr/^goto must have label at /, 'goto ""'; eval { goto }; like $@, qr/^goto must have label at /, 'argless goto'; eval { my $x = "\0"; goto $x }; like $@, qr/^Can't find label \0 at /, 'goto $x where $x begins with \0'; eval { goto "\0" }; like $@, qr/^Can't find label \0 at /, 'goto "\0"'; sub TIESCALAR { bless [pop] } sub FETCH { $_[0][0] } tie my $t, "", sub { "cluck up porridge" }; is eval { sub { goto $t }->() }//$@, 'cluck up porridge', 'tied arg returning sub ref';