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' if -d 't'; @INC = qw(. ../lib); require './test.pl'; } plan tests => 310; my $list_assignment_supported = 1; #mg.c says list assignment not supported on VMS and SYMBIAN. $list_assignment_supported = 0 if ($^O eq 'VMS'); sub foo { local($a, $b) = @_; local($c, $d); $c = "c 3"; $d = "d 4"; { local($a,$c) = ("a 9", "c 10"); ($x, $y) = ($a, $c); } is($a, "a 1"); is($b, "b 2"); $c, $d; } $a = "a 5"; $b = "b 6"; $c = "c 7"; $d = "d 8"; my @res; @res = &foo("a 1","b 2"); is($res[0], "c 3"); is($res[1], "d 4"); is($a, "a 5"); is($b, "b 6"); is($c, "c 7"); is($d, "d 8"); is($x, "a 9"); is($y, "c 10"); # same thing, only with arrays and associative arrays sub foo2 { local($a, @b) = @_; local(@c, %d); @c = "c 3"; $d{''} = "d 4"; { local($a,@c) = ("a 19", "c 20"); ($x, $y) = ($a, @c); } is($a, "a 1"); is("@b", "b 2"); $c[0], $d{''}; } $a = "a 5"; @b = "b 6"; @c = "c 7"; $d{''} = "d 8"; @res = &foo2("a 1","b 2"); is($res[0], "c 3"); is($res[1], "d 4"); is($a, "a 5"); is("@b", "b 6"); is($c[0], "c 7"); is($d{''}, "d 8"); is($x, "a 19"); is($y, "c 20"); eval 'local($$e)'; like($@, qr/Can't localize through a reference/); eval '$e = []; local(@$e)'; like($@, qr/Can't localize through a reference/); eval '$e = {}; local(%$e)'; like($@, qr/Can't localize through a reference/); # Array and hash elements @a = ('a', 'b', 'c'); { local($a[1]) = 'foo'; local($a[2]) = $a[2]; is($a[1], 'foo'); is($a[2], 'c'); undef @a; } is($a[1], 'b'); is($a[2], 'c'); ok(!defined $a[0]); @a = ('a', 'b', 'c'); { local($a[4]) = 'x'; ok(!defined $a[3]); is($a[4], 'x'); } is(scalar(@a), 3); ok(!exists $a[3]); ok(!exists $a[4]); @a = ('a', 'b', 'c'); { local($a[5]) = 'z'; $a[4] = 'y'; ok(!defined $a[3]); is($a[4], 'y'); is($a[5], 'z'); } is(scalar(@a), 5); ok(!defined $a[3]); is($a[4], 'y'); ok(!exists $a[5]); @a = ('a', 'b', 'c'); { local(@a[4,6]) = ('x', 'z'); ok(!defined $a[3]); is($a[4], 'x'); ok(!defined $a[5]); is($a[6], 'z'); } is(scalar(@a), 3); ok(!exists $a[3]); ok(!exists $a[4]); ok(!exists $a[5]); ok(!exists $a[6]); @a = ('a', 'b', 'c'); { local(@a[4,6]) = ('x', 'z'); $a[5] = 'y'; ok(!defined $a[3]); is($a[4], 'x'); is($a[5], 'y'); is($a[6], 'z'); } is(scalar(@a), 6); ok(!defined $a[3]); ok(!defined $a[4]); is($a[5], 'y'); ok(!exists $a[6]); @a = ('a', 'b', 'c'); { local($a[1]) = "X"; shift @a; } is($a[0].$a[1], "Xb"); { my $d = "@a"; local @a = @a; is("@a", $d); } @a = ('a', 'b', 'c'); $a[4] = 'd'; { delete local $a[1]; is(scalar(@a), 5); is($a[0], 'a'); ok(!exists($a[1])); is($a[2], 'c'); ok(!exists($a[3])); is($a[4], 'd'); ok(!exists($a[888])); delete local $a[888]; is(scalar(@a), 5); ok(!exists($a[888])); ok(!exists($a[999])); my ($d, $zzz) = delete local @a[4, 999]; is(scalar(@a), 3); ok(!exists($a[4])); ok(!exists($a[999])); is($d, 'd'); is($zzz, undef); my $c = delete local $a[2]; is(scalar(@a), 1); ok(!exists($a[2])); is($c, 'c'); $a[888] = 'yyy'; $a[999] = 'zzz'; } is(scalar(@a), 5); is($a[0], 'a'); is($a[1], 'b'); is($a[2], 'c'); ok(!defined($a[3])); is($a[4], 'd'); ok(!exists($a[5])); ok(!exists($a[888])); ok(!exists($a[999])); %h = (a => 1, b => 2, c => 3, d => 4); { delete local $h{b}; is(scalar(keys(%h)), 3); is($h{a}, 1); ok(!exists($h{b})); is($h{c}, 3); is($h{d}, 4); ok(!exists($h{yyy})); delete local $h{yyy}; is(scalar(keys(%h)), 3); ok(!exists($h{yyy})); ok(!exists($h{zzz})); my ($d, $zzz) = delete local @h{qw/d zzz/}; is(scalar(keys(%h)), 2); ok(!exists($h{d})); ok(!exists($h{zzz})); is($d, 4); is($zzz, undef); my $c = delete local $h{c}; is(scalar(keys(%h)), 1); ok(!exists($h{c})); is($c, 3); $h{yyy} = 888; $h{zzz} = 999; } is(scalar(keys(%h)), 4); is($h{a}, 1); is($h{b}, 2); is($h{c}, 3); ok($h{d}, 4); ok(!exists($h{yyy})); ok(!exists($h{zzz})); %h = ('a' => { 'b' => 1 }, 'c' => 2); { my $a = delete local $h{a}; is(scalar(keys(%h)), 1); ok(!exists($h{a})); is($h{c}, 2); is(scalar(keys(%$a)), 1); my $b = delete local $a->{b}; is(scalar(keys(%$a)), 0); is($b, 1); $a->{d} = 3; } is(scalar(keys(%h)), 2); { my $a = $h{a}; is(scalar(keys(%$a)), 2); is($a->{b}, 1); is($a->{d}, 3); } is($h{c}, 2); %h = ('a' => 1, 'b' => 2, 'c' => 3); { local($h{'a'}) = 'foo'; local($h{'b'}) = $h{'b'}; is($h{'a'}, 'foo'); is($h{'b'}, 2); local($h{'c'}); delete $h{'c'}; } is($h{'a'}, 1); is($h{'b'}, 2); { my $d = join("\n", map { "$_=>$h{$_}" } sort keys %h); local %h = %h; is(join("\n", map { "$_=>$h{$_}" } sort keys %h), $d); } is($h{'c'}, 3); # check for scope leakage $a = 'outer'; if (1) { local $a = 'inner' } is($a, 'outer'); # see if localization works when scope unwinds local $m = 5; eval { for $m (6) { local $m = 7; die "bye"; } }; is($m, 5); # see if localization works on tied arrays { package TA; sub TIEARRAY { bless [], $_[0] } sub STORE { print "# STORE [@_]\n"; $_[0]->[$_[1]] = $_[2] } sub FETCH { my $v = $_[0]->[$_[1]]; print "# FETCH [@_=$v]\n"; $v } sub EXISTS { print "# EXISTS [@_]\n"; exists $_[0]->[$_[1]]; } sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->[$_[1]]; } sub CLEAR { print "# CLEAR [@_]\n"; @{$_[0]} = (); } sub FETCHSIZE { scalar(@{$_[0]}) } sub SHIFT { shift (@{$_[0]}) } sub EXTEND {} } tie @a, 'TA'; @a = ('a', 'b', 'c'); { local($a[1]) = 'foo'; local($a[2]) = $a[2]; is($a[1], 'foo'); is($a[2], 'c'); @a = (); } is($a[1], 'b'); is($a[2], 'c'); ok(!defined $a[0]); { my $d = "@a"; local @a = @a; is("@a", $d); } # RT #7938: localising an array should make it temporarily untied { @a = qw(a b c); local @a = (6,7,8); is("@a", "6 7 8", 'local @a assigned 6,7,8'); { my $c = 0; local *TA::STORE = sub { $c++ }; $a[0] = 9; is($c, 0, 'STORE not called after array localised'); } is("@a", "9 7 8", 'local @a should now be 9 7 8'); } is("@a", "a b c", '@a should now contain original value'); # local() should preserve the existenceness of tied array elements @a = ('a', 'b', 'c'); { local($a[4]) = 'x'; ok(!defined $a[3]); is($a[4], 'x'); } is(scalar(@a), 3); ok(!exists $a[3]); ok(!exists $a[4]); @a = ('a', 'b', 'c'); { local($a[5]) = 'z'; $a[4] = 'y'; ok(!defined $a[3]); is($a[4], 'y'); is($a[5], 'z'); } is(scalar(@a), 5); ok(!defined $a[3]); is($a[4], 'y'); ok(!exists $a[5]); @a = ('a', 'b', 'c'); { local(@a[4,6]) = ('x', 'z'); ok(!defined $a[3]); is($a[4], 'x'); ok(!defined $a[5]); is($a[6], 'z'); } is(scalar(@a), 3); ok(!exists $a[3]); ok(!exists $a[4]); ok(!exists $a[5]); ok(!exists $a[6]); @a = ('a', 'b', 'c'); { local(@a[4,6]) = ('x', 'z'); $a[5] = 'y'; ok(!defined $a[3]); is($a[4], 'x'); is($a[5], 'y'); is($a[6], 'z'); } is(scalar(@a), 6); ok(!defined $a[3]); ok(!defined $a[4]); is($a[5], 'y'); ok(!exists $a[6]); @a = ('a', 'b', 'c'); $a[4] = 'd'; { delete local $a[1]; is(scalar(@a), 5); is($a[0], 'a'); ok(!exists($a[1])); is($a[2], 'c'); ok(!exists($a[3])); is($a[4], 'd'); ok(!exists($a[888])); delete local $a[888]; is(scalar(@a), 5); ok(!exists($a[888])); ok(!exists($a[999])); my ($d, $zzz) = delete local @a[4, 999]; is(scalar(@a), 3); ok(!exists($a[4])); ok(!exists($a[999])); is($d, 'd'); is($zzz, undef); my $c = delete local $a[2]; is(scalar(@a), 1); ok(!exists($a[2])); is($c, 'c'); $a[888] = 'yyy'; $a[999] = 'zzz'; } is(scalar(@a), 5); is($a[0], 'a'); is($a[1], 'b'); is($a[2], 'c'); ok(!defined($a[3])); is($a[4], 'd'); ok(!exists($a[5])); ok(!exists($a[888])); ok(!exists($a[999])); # see if localization works on tied hashes { package TH; sub TIEHASH { bless {}, $_[0] } sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] } sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v } sub EXISTS { print "# EXISTS [@_]\n"; exists $_[0]->{$_[1]}; } sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; } sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); } sub FIRSTKEY { print "# FIRSTKEY [@_]\n"; keys %{$_[0]}; each %{$_[0]} } sub NEXTKEY { print "# NEXTKEY [@_]\n"; each %{$_[0]} } } tie %h, 'TH'; %h = ('a' => 1, 'b' => 2, 'c' => 3); { local($h{'a'}) = 'foo'; local($h{'b'}) = $h{'b'}; local($h{'y'}); local($h{'z'}) = 33; is($h{'a'}, 'foo'); is($h{'b'}, 2); local($h{'c'}); delete $h{'c'}; } is($h{'a'}, 1); is($h{'b'}, 2); is($h{'c'}, 3); # local() should preserve the existenceness of tied hash elements ok(! exists $h{'y'}); ok(! exists $h{'z'}); TODO: { todo_skip("Localize entire tied hash"); my $d = join("\n", map { "$_=>$h{$_}" } sort keys %h); local %h = %h; is(join("\n", map { "$_=>$h{$_}" } sort keys %h), $d); } # RT #7939: localising a hash should make it temporarily untied { %h = qw(a 1 b 2 c 3); local %h = qw(x 6 y 7 z 8); is(join('', sort keys %h), "xyz", 'local %h has new keys'); is(join('', sort values %h), "678", 'local %h has new values'); { my $c = 0; local *TH::STORE = sub { $c++ }; $h{x} = 9; is($c, 0, 'STORE not called after hash localised'); } is($h{x}, 9, '$h{x} should now be 9'); } is(join('', sort keys %h), "abc", 'restored %h has original keys'); is(join('', sort values %h), "123", 'restored %h has original values'); %h = (a => 1, b => 2, c => 3, d => 4); { delete local $h{b}; is(scalar(keys(%h)), 3); is($h{a}, 1); ok(!exists($h{b})); is($h{c}, 3); is($h{d}, 4); ok(!exists($h{yyy})); delete local $h{yyy}; is(scalar(keys(%h)), 3); ok(!exists($h{yyy})); ok(!exists($h{zzz})); my ($d, $zzz) = delete local @h{qw/d zzz/}; is(scalar(keys(%h)), 2); ok(!exists($h{d})); ok(!exists($h{zzz})); is($d, 4); is($zzz, undef); my $c = delete local $h{c}; is(scalar(keys(%h)), 1); ok(!exists($h{c})); is($c, 3); $h{yyy} = 888; $h{zzz} = 999; } is(scalar(keys(%h)), 4); is($h{a}, 1); is($h{b}, 2); is($h{c}, 3); ok($h{d}, 4); ok(!exists($h{yyy})); ok(!exists($h{zzz})); @a = ('a', 'b', 'c'); { local($a[1]) = "X"; shift @a; } is($a[0].$a[1], "Xb"); # now try the same for %SIG $SIG{TERM} = 'foo'; $SIG{INT} = \&foo; $SIG{__WARN__} = $SIG{INT}; { local($SIG{TERM}) = $SIG{TERM}; local($SIG{INT}) = $SIG{INT}; local($SIG{__WARN__}) = $SIG{__WARN__}; is($SIG{TERM}, 'main::foo'); is($SIG{INT}, \&foo); is($SIG{__WARN__}, \&foo); local($SIG{INT}); delete $SIG{__WARN__}; } is($SIG{TERM}, 'main::foo'); is($SIG{INT}, \&foo); is($SIG{__WARN__}, \&foo); { my $d = join("\n", map { "$_=>$SIG{$_}" } sort keys %SIG); local %SIG = %SIG; is(join("\n", map { "$_=>$SIG{$_}" } sort keys %SIG), $d); } # and for %ENV $ENV{_X_} = 'a'; $ENV{_Y_} = 'b'; $ENV{_Z_} = 'c'; { local($ENV{_A_}); local($ENV{_B_}) = 'foo'; local($ENV{_X_}) = 'foo'; local($ENV{_Y_}) = $ENV{_Y_}; is($ENV{_X_}, 'foo'); is($ENV{_Y_}, 'b'); local($ENV{_Z_}); delete $ENV{_Z_}; } is($ENV{_X_}, 'a'); is($ENV{_Y_}, 'b'); is($ENV{_Z_}, 'c'); # local() should preserve the existenceness of %ENV elements ok(! exists $ENV{_A_}); ok(! exists $ENV{_B_}); SKIP: { skip("Can't make list assignment to \%ENV on this system") unless $list_assignment_supported; my $d = join("\n", map { "$_=>$ENV{$_}" } sort keys %ENV); local %ENV = %ENV; is(join("\n", map { "$_=>$ENV{$_}" } sort keys %ENV), $d); } # does implicit localization in foreach skip magic? $_ = "o 0,o 1,"; my $iter = 0; while (/(o.+?),/gc) { is($1, "o $iter"); foreach (1..1) { $iter++ } if ($iter > 2) { fail("endless loop"); last; } } { package UnderScore; sub TIESCALAR { bless \my $self, shift } sub FETCH { die "read \$_ forbidden" } sub STORE { die "write \$_ forbidden" } tie $_, __PACKAGE__; my @tests = ( "Nesting" => sub { print '#'; for (1..3) { print } print "\n" }, 1, "Reading" => sub { print }, 0, "Matching" => sub { $x = /badness/ }, 0, "Concat" => sub { $_ .= "a" }, 0, "Chop" => sub { chop }, 0, "Filetest" => sub { -x }, 0, "Assignment" => sub { $_ = "Bad" }, 0, "for local" => sub { for("#ok?\n"){ print } }, 1, ); while ( ($name, $code, $ok) = splice(@tests, 0, 3) ) { eval { &$code }; main::ok(($ok xor $@), "Underscore '$name'"); } untie $_; } { # BUG 20001205.022 (RT #4852) my %x; $x{a} = 1; { local $x{b} = 1; } ok(! exists $x{b}); { local @x{c,d,e}; } ok(! exists $x{c}); } # local() and readonly magic variables eval { local $1 = 1 }; like($@, qr/Modification of a read-only value attempted/); # local($_) always strips all magic eval { for ($1) { local $_ = 1 } }; is($@, ""); { my $STORE = my $FETCH = 0; package TieHash; sub TIEHASH { bless $_[1], $_[0] } sub FETCH { ++$FETCH; 42 } sub STORE { ++$STORE } package main; tie my %hash, "TieHash", {}; eval { for ($hash{key}) {local $_ = 2} }; is($STORE, 0); is($FETCH, 0); } # The s/// adds 'g' magic to $_, but it should remain non-readonly eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } }; is($@, ""); # sub localisation { package Other; sub f1 { "f1" } sub f2 { "f2" } no warnings "redefine"; { local *f1 = sub { "g1" }; ::ok(f1() eq "g1", "localised sub via glob"); } ::ok(f1() eq "f1", "localised sub restored"); { local $Other::{"f1"} = sub { "h1" }; ::ok(f1() eq "h1", "localised sub via stash"); } ::ok(f1() eq "f1", "localised sub restored"); { local @Other::{qw/ f1 f2 /} = (sub { "j1" }, sub { "j2" }); ::ok(f1() eq "j1", "localised sub via stash slice"); ::ok(f2() eq "j2", "localised sub via stash slice"); } ::ok(f1() eq "f1", "localised sub restored"); ::ok(f2() eq "f2", "localised sub restored"); } # Localising unicode keys (bug #38815) { my %h; $h{"\243"} = "pound"; $h{"\302\240"} = "octects"; is(scalar keys %h, 2); { my $unicode = chr 256; my $ambigous = "\240" . $unicode; chop $ambigous; local $h{$unicode} = 256; local $h{$ambigous} = 160; is(scalar keys %h, 4); is($h{"\243"}, "pound"); is($h{$unicode}, 256); is($h{$ambigous}, 160); is($h{"\302\240"}, "octects"); } is(scalar keys %h, 2); is($h{"\243"}, "pound"); is($h{"\302\240"}, "octects"); } # And with slices { my %h; $h{"\243"} = "pound"; $h{"\302\240"} = "octects"; is(scalar keys %h, 2); { my $unicode = chr 256; my $ambigous = "\240" . $unicode; chop $ambigous; local @h{$unicode, $ambigous} = (256, 160); is(scalar keys %h, 4); is($h{"\243"}, "pound"); is($h{$unicode}, 256); is($h{$ambigous}, 160); is($h{"\302\240"}, "octects"); } is(scalar keys %h, 2); is($h{"\243"}, "pound"); is($h{"\302\240"}, "octects"); } # [perl #39012] localizing @_ element then shifting frees element too # soon { my $x; my $y = bless [], 'X39012'; sub X39012::DESTROY { $x++ } sub { local $_[0]; shift }->($y); ok(!$x, '[perl #39012]'); } # when localising a hash element, the key should be copied, not referenced { my %h=('k1' => 111); my $k='k1'; { local $h{$k}=222; is($h{'k1'},222); $k='k2'; } ok(! exists($h{'k2'})); is($h{'k1'},111); } { my %h=('k1' => 111); our $k = 'k1'; # try dynamic too { local $h{$k}=222; is($h{'k1'},222); $k='k2'; } ok(! exists($h{'k2'})); is($h{'k1'},111); } like( runperl(stderr => 1, prog => 'use constant foo => q(a);' . 'index(q(a), foo);' . 'local *g=${::}{foo};print q(ok);'), "ok", "[perl #52740]"); # related to perl #112966 # Magic should not cause elements not to be deleted after scope unwinding # when they did not exist before local() () = \$#squinch; # $#foo in lvalue context makes array magical { local $squinch[0]; local @squinch[1..2]; package Flibbert; m??; # makes stash magical local $Flibbert::{foo}; local @Flibbert::{<bar baz>}; } ok !exists $Flibbert::{foo}, 'local helem on magic hash does not leave elems on scope exit'; ok !exists $Flibbert::{bar}, 'local hslice on magic hash does not leave elems on scope exit'; ok !exists $squinch[0], 'local aelem on magic hash does not leave elems on scope exit'; ok !exists $squinch[1], 'local aslice on magic hash does not leave elems on scope exit'; # Keep these tests last, as they can SEGV { local *@; pass("Localised *@"); eval {1}; pass("Can eval with *@ localised"); local @{"nugguton"}; local %{"netgonch"}; delete $::{$_} for 'nugguton','netgonch'; } pass ('localised arrays and hashes do not crash if glob is deleted'); # [perl #112966] Rmagic can cause delete local to crash package Grompits { local $SIG{__WARN__}; delete local $ISA[0]; delete local @ISA[1..10]; m??; # makes stash magical delete local $Grompits::{foo}; delete local @Grompits::{<foo bar>}; } pass 'rmagic does not cause delete local to crash on nonexistent elems';