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 BEGIN { chdir 't'; @INC = '../lib'; require './test.pl'; *bar::is = *is; *bar::like = *like; } plan 126; # -------------------- Errors with feature disabled -------------------- # eval "#line 8 foo\nmy sub foo"; is $@, qq 'Experimental "my" subs not enabled at foo line 8.\n', 'my sub unexperimental error'; eval "#line 8 foo\nCORE::state sub foo"; is $@, qq 'Experimental "state" subs not enabled at foo line 8.\n', 'state sub unexperimental error'; eval "#line 8 foo\nour sub foo"; is $@, qq 'Experimental "our" subs not enabled at foo line 8.\n', 'our sub unexperimental error'; # -------------------- our -------------------- # no warnings "experimental::lexical_subs"; use feature 'lexical_subs'; { our sub foo { 42 } is foo, 42, 'calling our sub from same package'; is &foo, 42, 'calling our sub from same package (amper)'; package bar; sub bar::foo { 43 } is foo, 42, 'calling our sub from another package'; is &foo, 42, 'calling our sub from another package (amper)'; } package bar; is foo, 43, 'our sub falling out of scope'; is &foo, 43, 'our sub falling out of scope (called via amper)'; package main; { sub bar::a { 43 } our sub a { if (shift) { package bar; is a, 43, 'our sub invisible inside itself'; is &a, 43, 'our sub invisible inside itself (called via amper)'; } 42 } a(1); sub bar::b { 43 } our sub b; our sub b { if (shift) { package bar; is b, 42, 'our sub visible inside itself after decl'; is &b, 42, 'our sub visible inside itself after decl (amper)'; } 42 } b(1) } sub c { 42 } sub bar::c { 43 } { our sub c; package bar; is c, 42, 'our sub foo; makes lex alias for existing sub'; is &c, 42, 'our sub foo; makes lex alias for existing sub (amper)'; } { our sub d; sub bar::d { 'd43' } package bar; sub d { 'd42' } is eval ::d, 'd42', 'our sub foo; applies to subsequent sub foo {}'; } { our sub e ($); is prototype "::e", '$', 'our sub with proto'; } { our sub if() { 42 } my $x = if if if; is $x, 42, 'lexical subs (even our) override all keywords'; package bar; my $y = if if if; is $y, 42, 'our subs from other packages override all keywords'; } # -------------------- state -------------------- # use feature 'state'; # state { state sub foo { 44 } isnt \&::foo, \&foo, 'state sub is not stored in the package'; is eval foo, 44, 'calling state sub from same package'; is eval &foo, 44, 'calling state sub from same package (amper)'; package bar; is eval foo, 44, 'calling state sub from another package'; is eval &foo, 44, 'calling state sub from another package (amper)'; } package bar; is foo, 43, 'state sub falling out of scope'; is &foo, 43, 'state sub falling out of scope (called via amper)'; { sub sa { 43 } state sub sa { if (shift) { is sa, 43, 'state sub invisible inside itself'; is &sa, 43, 'state sub invisible inside itself (called via amper)'; } 44 } sa(1); sub sb { 43 } state sub sb; state sub sb { if (shift) { # ‘state sub foo{}’ creates a new pad entry, not reusing the forward # declaration. Being invisible inside itself, it sees the stub. eval{sb}; like $@, qr/^Undefined subroutine &sb called at /, 'state sub foo {} after forward declaration'; eval{&sb}; like $@, qr/^Undefined subroutine &sb called at /, 'state sub foo {} after forward declaration (amper)'; } 44 } sb(1); sub sb2 { 43 } state sub sb2; sub sb2 { if (shift) { package bar; is sb2, 44, 'state sub visible inside itself after decl'; is &sb2, 44, 'state sub visible inside itself after decl (amper)'; } 44 } sb2(1); state sub sb3; { state sub sb3 { # new pad entry # The sub containing this comment is invisible inside itself. # So this one here will assign to the outer pad entry: sub sb3 { 47 } } } is eval{sb3}, 47, 'sub foo{} applying to "state sub foo;" even inside state sub foo{}'; # Same test again, but inside an anonymous sub sub { state sub sb4; { state sub sb4 { sub sb4 { 47 } } } is sb4, 47, 'sub foo{} applying to "state sub foo;" even inside state sub foo{}'; }->(); } sub sc { 43 } { state sub sc; eval{sc}; like $@, qr/^Undefined subroutine &sc called at /, 'state sub foo; makes no lex alias for existing sub'; eval{&sc}; like $@, qr/^Undefined subroutine &sc called at /, 'state sub foo; makes no lex alias for existing sub (amper)'; } package main; { state sub se ($); is prototype eval{\&se}, '$', 'state sub with proto'; is prototype "se", undef, 'prototype "..." ignores state subs'; } { state sub if() { 44 } my $x = if if if; is $x, 44, 'state subs override all keywords'; package bar; my $y = if if if; is $y, 44, 'state subs from other packages override all keywords'; } { use warnings; no warnings "experimental::lexical_subs"; state $w ; local $SIG{__WARN__} = sub { $w .= shift }; eval '#line 87 squidges state sub foo; state sub foo {}; '; is $w, '"state" subroutine &foo masks earlier declaration in same scope at ' . "squidges line 88.\n", 'warning for state sub masking earlier declaration'; } # Since state vars inside anonymous subs are cloned at the same time as the # anonymous subs containing them, the same should happen for state subs. sub make_closure { my $x = shift; sub { state sub foo { $x } foo } } $sub1 = make_closure 48; $sub2 = make_closure 49; is &$sub1, 48, 'state sub in closure (1)'; is &$sub2, 49, 'state sub in closure (2)'; # But we need to test that state subs actually do persist from one invoca- # tion of a named sub to another (i.e., that they are not my subs). { use warnings; no warnings "experimental::lexical_subs"; state $w; local $SIG{__WARN__} = sub { $w .= shift }; eval '#line 65 teetet sub foom { my $x = shift; state sub poom { $x } eval{\&poom} } '; is $w, "Variable \"\$x\" will not stay shared at teetet line 67.\n", 'state subs get "Variable will not stay shared" messages'; my $poom = foom(27); my $poom2 = foom(678); is eval{$poom->()}, eval {$poom2->()}, 'state subs close over the first outer my var, like pkg subs'; my $x = 43; for $x (765) { state sub etetetet { $x } is eval{etetetet}, 43, 'state sub ignores for() localisation'; } } # And we also need to test that multiple state subs can close over each # other’s entries in the parent subs pad, and that cv_clone is not con- # fused by that. sub make_anon_with_state_sub{ sub { state sub s1; state sub s2 { \&s1 } sub s1 { \&s2 } if (@_) { return \&s1 } is s1,\&s2, 'state sub in anon closure closing over sibling state sub'; is s2,\&s1, 'state sub in anon closure closing over sibling state sub'; } } { my $s = make_anon_with_state_sub; &$s; # And make sure the state subs were actually cloned. isnt make_anon_with_state_sub->(0), &$s(0), 'state subs in anon subs are cloned'; is &$s(0), &$s(0), 'but only when the anon sub is cloned'; } { state sub BEGIN { exit }; pass 'state subs are never special blocks'; state sub END { shift } is eval{END('jkqeudth')}, jkqeudth, 'state sub END {shift} implies @_, not @ARGV'; state sub CORE { scalar reverse shift } is CORE::uc("hello"), "HELLO", 'lexical CORE does not interfere with CORE::...'; } { state sub redef {} use warnings; no warnings "experimental::lexical_subs"; state $w; local $SIG{__WARN__} = sub { $w .= shift }; eval "#line 56 pygpyf\nsub redef {}"; is $w, "Subroutine redef redefined at pygpyf line 56.\n", "sub redefinition warnings from state subs"; } { state sub p (\@) { is ref $_[0], 'ARRAY', 'state sub with proto'; } p(my @a); p my @b; state sub q () { 45 } is q(), 45, 'state constant called with parens'; } { state sub x; eval 'sub x {3}'; is x, 3, 'state sub defined inside eval'; sub r { state sub foo { 3 }; if (@_) { # outer call r(); is foo(), 42, 'state sub run-time redefinition applies to all recursion levels'; } else { # inner call eval 'sub foo { 42 }'; } } r(1); } like runperl( switches => [ '-Mfeature=lexical_subs,state' ], prog => 'state sub a { foo ref } a()', stderr => 1 ), qr/syntax error/, 'referencing a state sub after a syntax error does not crash'; { state $stuff; package A { state sub foo{ $stuff .= our $AUTOLOAD } *A::AUTOLOAD = \&foo; } A::bar(); is $stuff, 'A::bar', 'state sub assigned to *AUTOLOAD can autoload'; } { state sub quire{qr "quires"} package o { use overload qr => \&quire } ok "quires" =~ bless([], o::), 'state sub used as overload method'; } { local $ENV{PERL5DB} = 'sub DB::DB{}'; is( runperl( switches => [ '-d' ], progs => [ split "\n", 'use feature qw - lexical_subs state -; no warnings q-experimental::lexical_subs-; sub DB::sub{ print qq|4\n|; goto $DB::sub } state sub foo {print qq|2\n|} foo(); ' ], stderr => 1 ), "4\n2\n", 'state subs and DB::sub under -d' ); } # -------------------- my -------------------- # { my sub foo { 44 } isnt \&::foo, \&foo, 'my sub is not stored in the package'; is foo, 44, 'calling my sub from same package'; is &foo, 44, 'calling my sub from same package (amper)'; package bar; is foo, 44, 'calling my sub from another package'; is &foo, 44, 'calling my sub from another package (amper)'; } package bar; is foo, 43, 'my sub falling out of scope'; is &foo, 43, 'my sub falling out of scope (called via amper)'; { sub ma { 43 } my sub ma { if (shift) { is ma, 43, 'my sub invisible inside itself'; is &ma, 43, 'my sub invisible inside itself (called via amper)'; } 44 } ma(1); sub mb { 43 } my sub mb; my sub mb { if (shift) { # ‘my sub foo{}’ creates a new pad entry, not reusing the forward # declaration. Being invisible inside itself, it sees the stub. eval{mb}; like $@, qr/^Undefined subroutine &mb called at /, 'my sub foo {} after forward declaration'; eval{&mb}; like $@, qr/^Undefined subroutine &mb called at /, 'my sub foo {} after forward declaration (amper)'; } 44 } mb(1); sub mb2 { 43 } my sub sb2; sub mb2 { if (shift) { package bar; is mb2, 44, 'my sub visible inside itself after decl'; is &mb2, 44, 'my sub visible inside itself after decl (amper)'; } 44 } mb2(1); my sub mb3; { my sub mb3 { # new pad entry # The sub containing this comment is invisible inside itself. # So this one here will assign to the outer pad entry: sub mb3 { 47 } } } is eval{mb3}, 47, 'sub foo{} applying to "my sub foo;" even inside my sub foo{}'; # Same test again, but inside an anonymous sub sub { my sub mb4; { my sub mb4 { sub mb4 { 47 } } } is mb4, 47, 'sub foo{} applying to "my sub foo;" even inside my sub foo{}'; }->(); } sub mc { 43 } { my sub mc; eval{mc}; like $@, qr/^Undefined subroutine &mc called at /, 'my sub foo; makes no lex alias for existing sub'; eval{&mc}; like $@, qr/^Undefined subroutine &mc called at /, 'my sub foo; makes no lex alias for existing sub (amper)'; } package main; { my sub me ($); is prototype eval{\&me}, '$', 'my sub with proto'; is prototype "me", undef, 'prototype "..." ignores my subs'; my $coderef = eval "my sub foo (\$\x{30cd}) {1}; \\&foo"; my $proto = prototype $coderef; ok(utf8::is_utf8($proto), "my sub with UTF8 proto maintains the UTF8ness"); is($proto, "\$\x{30cd}", "check the prototypes actually match"); } { my sub if() { 44 } my $x = if if if; is $x, 44, 'my subs override all keywords'; package bar; my $y = if if if; is $y, 44, 'my subs from other packages override all keywords'; } { use warnings; no warnings "experimental::lexical_subs"; my $w ; local $SIG{__WARN__} = sub { $w .= shift }; eval '#line 87 squidges my sub foo; my sub foo {}; '; is $w, '"my" subroutine &foo masks earlier declaration in same scope at ' . "squidges line 88.\n", 'warning for my sub masking earlier declaration'; } # Test that my subs are cloned inside anonymous subs. sub mmake_closure { my $x = shift; sub { my sub foo { $x } foo } } $sub1 = mmake_closure 48; $sub2 = mmake_closure 49; is &$sub1, 48, 'my sub in closure (1)'; is &$sub2, 49, 'my sub in closure (2)'; # Test that they are cloned in named subs. { use warnings; no warnings "experimental::lexical_subs"; my $w; local $SIG{__WARN__} = sub { $w .= shift }; eval '#line 65 teetet sub mfoom { my $x = shift; my sub poom { $x } \&poom } '; is $w, undef, 'my subs get no "Variable will not stay shared" messages'; my $poom = mfoom(27); my $poom2 = mfoom(678); is $poom->(), 27, 'my subs closing over outer my var (1)'; is $poom2->(), 678, 'my subs closing over outer my var (2)'; my $x = 43; my sub aoeu; for $x (765) { my sub etetetet { $x } sub aoeu { $x } is etetetet, 765, 'my sub respects for() localisation'; is aoeu, 43, 'unless it is declared outside the for loop'; } } # And we also need to test that multiple my subs can close over each # other’s entries in the parent subs pad, and that cv_clone is not con- # fused by that. sub make_anon_with_my_sub{ sub { my sub s1; my sub s2 { \&s1 } sub s1 { \&s2 } if (@_) { return eval { \&s1 } } is eval{s1},eval{\&s2}, 'my sub in anon closure closing over sibling my sub'; is eval{s2},eval{\&s1}, 'my sub in anon closure closing over sibling my sub'; } } # Test my subs inside predeclared my subs { my sub s2; sub s2 { my $x = 3; my sub s3 { eval '$x' } s3; } is s2, 3, 'my sub inside predeclared my sub'; } { my $s = make_anon_with_my_sub; &$s; # And make sure the my subs were actually cloned. isnt make_anon_with_my_sub->(0), &$s(0), 'my subs in anon subs are cloned'; isnt &$s(0), &$s(0), 'at each invocation of the enclosing sub'; } { my sub BEGIN { exit }; pass 'my subs are never special blocks'; my sub END { shift } is END('jkqeudth'), jkqeudth, 'my sub END {shift} implies @_, not @ARGV'; } { my sub redef {} use warnings; no warnings "experimental::lexical_subs"; my $w; local $SIG{__WARN__} = sub { $w .= shift }; eval "#line 56 pygpyf\nsub redef {}"; is $w, "Subroutine redef redefined at pygpyf line 56.\n", "sub redefinition warnings from my subs"; undef $w; sub { my sub x {}; sub { eval "#line 87 khaki\n\\&x" } }->()(); is $w, "Subroutine \"&x\" is not available at khaki line 87.\n", "unavailability warning during compilation of eval in closure"; undef $w; no warnings 'void'; eval <<'->()();'; #line 87 khaki sub { my sub x{} sub not_lexical8 { \&x } } ->()(); is $w, "Subroutine \"&x\" is not available at khaki line 90.\n", "unavailability warning during compilation of named sub in anon"; undef $w; sub not_lexical9 { my sub x {}; format = @ &x . } eval { write }; my($f,$l) = (__FILE__,__LINE__ - 1); is $w, "Subroutine \"&x\" is not available at $f line $l.\n", 'unavailability warning during cloning'; $l -= 3; is $@, "Undefined subroutine &x called at $f line $l.\n", 'Vivified sub is correctly named'; } sub not_lexical10 { my sub foo; foo(); sub not_lexical11 { my sub bar { my $x = 'khaki car keys for the khaki car'; not_lexical10(); sub foo { is $x, 'khaki car keys for the khaki car', 'mysubs in inner clonables use the running clone of their CvOUTSIDE' } } bar() } } not_lexical11(); { my sub p (\@) { is ref $_[0], 'ARRAY', 'my sub with proto'; } p(my @a); p @a; my sub q () { 46 } is q(), 46, 'my constant called with parens'; } { my sub x; my $count; sub x { x() if $count++ < 10 } x(); is $count, 11, 'my recursive subs'; } { my sub x; eval 'sub x {3}'; is x, 3, 'my sub defined inside eval'; } { state $w; local $SIG{__WARN__} = sub { $w .= shift }; eval q{ my sub george () { 2 } }; is $w, undef, 'no double free from constant my subs'; } like runperl( switches => [ '-Mfeature=lexical_subs,state' ], prog => 'my sub a { foo ref } a()', stderr => 1 ), qr/syntax error/, 'referencing a my sub after a syntax error does not crash'; { state $stuff; package A { my sub foo{ $stuff .= our $AUTOLOAD } *A::AUTOLOAD = \&foo; } A::bar(); is $stuff, 'A::bar', 'my sub assigned to *AUTOLOAD can autoload'; } { my sub quire{qr "quires"} package mo { use overload qr => \&quire } ok "quires" =~ bless([], mo::), 'my sub used as overload method'; } { local $ENV{PERL5DB} = 'sub DB::DB{}'; is( runperl( switches => [ '-d' ], progs => [ split "\n", 'use feature qw - lexical_subs state -; no warnings q-experimental::lexical_subs-; sub DB::sub{ print qq|4\n|; goto $DB::sub } my sub foo {print qq|2\n|} foo(); ' ], stderr => 1 ), "4\n2\n", 'my subs and DB::sub under -d' ); } # -------------------- Interactions (and misc tests) -------------------- # is sub { my sub s1; my sub s2 { 3 }; sub s1 { state sub foo { \&s2 } foo } s1 }->()(), 3, 'state sub inside my sub closing over my sub uncle'; { my sub s2 { 3 }; sub not_lexical { state sub foo { \&s2 } foo } is not_lexical->(), 3, 'state subs that reference my sub from outside'; } # Test my subs inside predeclared package subs # This test also checks that CvOUTSIDE pointers are not mangled when the # inner sub’s CvOUTSIDE points to another sub. sub not_lexical2; sub not_lexical2 { my $x = 23; my sub bar; sub not_lexical3 { not_lexical2(); sub bar { $x } }; bar } is not_lexical3, 23, 'my subs inside predeclared package subs'; # Test my subs inside predeclared package sub, where the lexical sub is # declared outside the package sub. # This checks that CvOUTSIDE pointers are fixed up even when the sub is # not declared inside the sub that its CvOUTSIDE points to. sub not_lexical5 { my sub foo; sub not_lexical4; sub not_lexical4 { my $x = 234; not_lexical5(); sub foo { $x } } foo } is not_lexical4, 234, 'my sub defined in predeclared pkg sub but declared outside'; undef *not_lexical6; { my sub foo; sub not_lexical6 { sub foo { } } pass 'no crash when cloning a mysub declared inside an undef pack sub'; } undef ¬_lexical7; eval 'sub not_lexical7 { my @x }'; { my sub foo; foo(); sub not_lexical7 { state $x; sub foo { is ref \$x, 'SCALAR', "redeffing a mysub's outside does not make it use the wrong pad" } } } like runperl( switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ], prog => 'my sub foo; sub foo { foo } foo', stderr => 1 ), qr/Deep recursion on subroutine "foo"/, 'deep recursion warnings for lexical subs do not crash'; like runperl( switches => [ '-Mfeature=lexical_subs,state', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ], prog => 'my sub foo() { 42 } undef &foo', stderr => 1 ), qr/Constant subroutine foo undefined at /, 'constant undefinition warnings for lexical subs do not crash'; { my sub foo; *AutoloadTestSuper::blah = \&foo; sub AutoloadTestSuper::AUTOLOAD { is $AutoloadTestSuper::AUTOLOAD, "AutoloadTestSuper::blah", "Autoloading via inherited lex stub"; } @AutoloadTest::ISA = AutoloadTestSuper::; AutoloadTest->blah; }