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 -w BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; } # use strict; plan tests => 309; my @comma = ("key", "value"); # The peephole optimiser already knows that it should convert the string in # $foo{string} into a shared hash key scalar. It might be worth making the # tokeniser build the LHS of => as a shared hash key scalar too. # And so there's the possiblility of it going wrong # And going right on 8 bit but wrong on utf8 keys. # And really we should also try utf8 literals in {} and => in utf8.t # Some of these tests are (effectively) duplicated in each.t my %comma = @comma; ok (keys %comma == 1, 'keys on comma hash'); ok (values %comma == 1, 'values on comma hash'); # defeat any tokeniser or optimiser cunning my $key = 'ey'; is ($comma{"k" . $key}, "value", 'is key present? (unoptimised)'); # now with cunning: is ($comma{key}, "value", 'is key present? (maybe optimised)'); #tokeniser may treat => differently. my @temp = (key=>undef); is ($comma{$temp[0]}, "value", 'is key present? (using LHS of =>)'); @temp = %comma; ok (eq_array (\@comma, \@temp), 'list from comma hash'); @temp = each %comma; ok (eq_array (\@comma, \@temp), 'first each from comma hash'); @temp = each %comma; ok (eq_array ([], \@temp), 'last each from comma hash'); my %temp = %comma; ok (keys %temp == 1, 'keys on copy of comma hash'); ok (values %temp == 1, 'values on copy of comma hash'); is ($temp{'k' . $key}, "value", 'is key present? (unoptimised)'); # now with cunning: is ($temp{key}, "value", 'is key present? (maybe optimised)'); @temp = (key=>undef); is ($comma{$temp[0]}, "value", 'is key present? (using LHS of =>)'); @temp = %temp; ok (eq_array (\@temp, \@temp), 'list from copy of comma hash'); @temp = each %temp; ok (eq_array (\@temp, \@temp), 'first each from copy of comma hash'); @temp = each %temp; ok (eq_array ([], \@temp), 'last each from copy of comma hash'); my @arrow = (Key =>"Value"); my %arrow = @arrow; ok (keys %arrow == 1, 'keys on arrow hash'); ok (values %arrow == 1, 'values on arrow hash'); # defeat any tokeniser or optimiser cunning $key = 'ey'; is ($arrow{"K" . $key}, "Value", 'is key present? (unoptimised)'); # now with cunning: is ($arrow{Key}, "Value", 'is key present? (maybe optimised)'); #tokeniser may treat => differently. @temp = ('Key', undef); is ($arrow{$temp[0]}, "Value", 'is key present? (using LHS of =>)'); @temp = %arrow; ok (eq_array (\@arrow, \@temp), 'list from arrow hash'); @temp = each %arrow; ok (eq_array (\@arrow, \@temp), 'first each from arrow hash'); @temp = each %arrow; ok (eq_array ([], \@temp), 'last each from arrow hash'); %temp = %arrow; ok (keys %temp == 1, 'keys on copy of arrow hash'); ok (values %temp == 1, 'values on copy of arrow hash'); is ($temp{'K' . $key}, "Value", 'is key present? (unoptimised)'); # now with cunning: is ($temp{Key}, "Value", 'is key present? (maybe optimised)'); @temp = ('Key', undef); is ($arrow{$temp[0]}, "Value", 'is key present? (using LHS of =>)'); @temp = %temp; ok (eq_array (\@temp, \@temp), 'list from copy of arrow hash'); @temp = each %temp; ok (eq_array (\@temp, \@temp), 'first each from copy of arrow hash'); @temp = each %temp; ok (eq_array ([], \@temp), 'last each from copy of arrow hash'); my %direct = ('Camel', 2, 'Dromedary', 1); my %slow; $slow{Dromedary} = 1; $slow{Camel} = 2; ok (eq_hash (\%slow, \%direct), "direct list assignment to hash"); %direct = (Camel => 2, 'Dromedary' => 1); ok (eq_hash (\%slow, \%direct), "direct list assignment to hash using =>"); $slow{Llama} = 0; # A llama is not a camel :-) ok (!eq_hash (\%direct, \%slow), "different hashes should not be equal!"); my (%names, %names_copy); %names = ('$' => 'Scalar', '@' => 'Array', # Grr ' '%', 'Hash', '&', 'Code'); %names_copy = %names; ok (eq_hash (\%names, \%names_copy), "check we can copy our hash"); sub in { my %args = @_; return eq_hash (\%names, \%args); } ok (in (%names), "pass hash into a method"); sub in_method { my $self = shift; my %args = @_; return eq_hash (\%names, \%args); } ok (main->in_method (%names), "pass hash into a method"); sub out { return %names; } %names_copy = out (); ok (eq_hash (\%names, \%names_copy), "pass hash from a subroutine"); sub out_method { my $self = shift; return %names; } %names_copy = main->out_method (); ok (eq_hash (\%names, \%names_copy), "pass hash from a method"); sub in_out { my %args = @_; return %args; } %names_copy = in_out (%names); ok (eq_hash (\%names, \%names_copy), "pass hash to and from a subroutine"); sub in_out_method { my $self = shift; my %args = @_; return %args; } %names_copy = main->in_out_method (%names); ok (eq_hash (\%names, \%names_copy), "pass hash to and from a method"); my %names_copy2 = %names; ok (eq_hash (\%names, \%names_copy2), "check copy worked"); # This should get ignored. %names_copy = ('%', 'Associative Array', %names); ok (eq_hash (\%names, \%names_copy), "duplicates at the start of a list"); # This should not %names_copy = ('*', 'Typeglob', %names); $names_copy2{'*'} = 'Typeglob'; ok (eq_hash (\%names_copy, \%names_copy2), "duplicates at the end of a list"); %names_copy = ('%', 'Associative Array', '*', 'Endangered species', %names, '*', 'Typeglob',); ok (eq_hash (\%names_copy, \%names_copy2), "duplicates at both ends"); # And now UTF8 foreach my $chr (60, 200, 600, 6000, 60000) { # This little game may set a UTF8 flag internally. Or it may not. :-) my ($key, $value) = (chr ($chr) . "\x{ABCD}", "$chr\x{ABCD}"); chop ($key, $value); my @utf8c = ($key, $value); my %utf8c = @utf8c; ok (keys %utf8c == 1, 'keys on utf8 comma hash'); ok (values %utf8c == 1, 'values on utf8 comma hash'); # defeat any tokeniser or optimiser cunning is ($utf8c{"" . $key}, $value, 'is key present? (unoptimised)'); my $tempval = sprintf '$utf8c{"\x{%x}"}', $chr; is (eval $tempval, $value, "is key present? (maybe $tempval is optimised)"); $tempval = sprintf '@temp = ("\x{%x}" => undef)', $chr; eval $tempval or die "'$tempval' gave $@"; is ($utf8c{$temp[0]}, $value, 'is key present? (using LHS of $tempval)'); @temp = %utf8c; ok (eq_array (\@utf8c, \@temp), 'list from utf8 comma hash'); @temp = each %utf8c; ok (eq_array (\@utf8c, \@temp), 'first each from utf8 comma hash'); @temp = each %utf8c; ok (eq_array ([], \@temp), 'last each from utf8 comma hash'); %temp = %utf8c; ok (keys %temp == 1, 'keys on copy of utf8 comma hash'); ok (values %temp == 1, 'values on copy of utf8 comma hash'); is ($temp{"" . $key}, $value, 'is key present? (unoptimised)'); $tempval = sprintf '$temp{"\x{%x}"}', $chr; is (eval $tempval, $value, "is key present? (maybe $tempval is optimised)"); $tempval = sprintf '@temp = ("\x{%x}" => undef)', $chr; eval $tempval or die "'$tempval' gave $@"; is ($temp{$temp[0]}, $value, "is key present? (using LHS of $tempval)"); @temp = %temp; ok (eq_array (\@temp, \@temp), 'list from copy of utf8 comma hash'); @temp = each %temp; ok (eq_array (\@temp, \@temp), 'first each from copy of utf8 comma hash'); @temp = each %temp; ok (eq_array ([], \@temp), 'last each from copy of utf8 comma hash'); my $assign = sprintf '("\x{%x}" => "%d")', $chr, $chr; print "# $assign\n"; my (@utf8a) = eval $assign; my %utf8a = @utf8a; ok (keys %utf8a == 1, 'keys on utf8 arrow hash'); ok (values %utf8a == 1, 'values on utf8 arrow hash'); # defeat any tokeniser or optimiser cunning is ($utf8a{$key . ""}, $value, 'is key present? (unoptimised)'); $tempval = sprintf '$utf8a{"\x{%x}"}', $chr; is (eval $tempval, $value, "is key present? (maybe $tempval is optimised)"); $tempval = sprintf '@temp = ("\x{%x}" => undef)', $chr; eval $tempval or die "'$tempval' gave $@"; is ($utf8a{$temp[0]}, $value, "is key present? (using LHS of $tempval)"); @temp = %utf8a; ok (eq_array (\@utf8a, \@temp), 'list from utf8 arrow hash'); @temp = each %utf8a; ok (eq_array (\@utf8a, \@temp), 'first each from utf8 arrow hash'); @temp = each %utf8a; ok (eq_array ([], \@temp), 'last each from utf8 arrow hash'); %temp = %utf8a; ok (keys %temp == 1, 'keys on copy of utf8 arrow hash'); ok (values %temp == 1, 'values on copy of utf8 arrow hash'); is ($temp{'' . $key}, $value, 'is key present? (unoptimised)'); $tempval = sprintf '$temp{"\x{%x}"}', $chr; is (eval $tempval, $value, "is key present? (maybe $tempval is optimised)"); $tempval = sprintf '@temp = ("\x{%x}" => undef)', $chr; eval $tempval or die "'$tempval' gave $@"; is ($temp{$temp[0]}, $value, "is key present? (using LHS of $tempval)"); @temp = %temp; ok (eq_array (\@temp, \@temp), 'list from copy of utf8 arrow hash'); @temp = each %temp; ok (eq_array (\@temp, \@temp), 'first each from copy of utf8 arrow hash'); @temp = each %temp; ok (eq_array ([], \@temp), 'last each from copy of utf8 arrow hash'); } # now some tests for hash assignment in scalar and list context with # duplicate keys [perl #24380], [perl #31865] { my %h; my $x; my $ar; is( (join ':', %h = (1) x 8), '1:1', 'hash assignment in list context removes duplicates' ); is( (join ':', %h = qw(a 1 a 2 b 3 c 4 d 5 d 6)), 'a:2:b:3:c:4:d:6', 'hash assignment in list context removes duplicates 2' ); is( scalar( %h = (1,2,1,3,1,4,1,5) ), 8, 'hash assignment in scalar context' ); is( scalar( ($x,%h) = (0,1,2,1,3,1,4,1,5) ), 9, 'scalar + hash assignment in scalar context' ); $ar = [ %h = (1,2,1,3,1,4,1,5) ]; is( $#$ar, 1, 'hash assignment in list context' ); is( "@$ar", "1 5", '...gets the last values' ); $ar = [ ($x,%h) = (0,1,2,1,3,1,4,1,5) ]; is( $#$ar, 2, 'scalar + hash assignment in list context' ); is( "@$ar", "0 1 5", '...gets the last values' ); } # test stringification of keys { no warnings 'once'; my @types = qw( SCALAR ARRAY HASH CODE GLOB); my @refs = ( \ do { my $x }, [], {}, sub {}, \ *x); my(%h, %expect); @h{@refs} = @types; @expect{map "$_", @refs} = @types; ok (eq_hash(\%h, \%expect), 'unblessed ref stringification'); bless $_ for @refs; %h = (); %expect = (); @h{@refs} = @types; @expect{map "$_", @refs} = @types; ok (eq_hash(\%h, \%expect), 'blessed ref stringification'); } # [perl #76716] Hash assignment should not zap weak refs. SKIP: { skip_if_miniperl("no dynamic loading on miniperl, no Scalar::Util", 2); my %tb; require Scalar::Util; Scalar::Util::weaken(my $p = \%tb); %tb = (); is $p, \%tb, "hash assignment should not zap weak refs"; undef %tb; is $p, \%tb, "hash undef should not zap weak refs"; } # test odd hash assignment warnings { my ($s, %h); warning_like(sub {%h = (1..3)}, qr/^Odd number of elements in hash assignment/); warning_like(sub {%h = ({})}, qr/^Reference found where even-sized list expected/); warning_like(sub { ($s, %h) = (1..4)}, qr/^Odd number of elements in hash assignment/); warning_like(sub { ($s, %h) = (1, {})}, qr/^Reference found where even-sized list expected/); } # hash assignment in scalar and list context with odd number of elements { no warnings 'misc', 'uninitialized'; my %h; my $x; is( join( ':', %h = (1..3)), '1:2:3:', 'odd hash assignment in list context' ); ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" ); is( scalar( %h = (1..3) ), 3, 'odd hash assignment in scalar context' ); ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" ); is( join(':', ($x,%h) = (0,1,2,3) ), '0:1:2:3:', 'scalar + odd hash assignment in list context' ); ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" ); is( scalar( ($x,%h) = (0,1,2,3) ), 4, 'scalar + odd hash assignment in scalar context' ); ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" ); } # hash assignment in scalar and list context with odd number of elements # and duplicates { no warnings 'misc', 'uninitialized'; my %h; my $x; is( (join ':', %h = (1,1,1)), '1:', 'odd hash assignment in list context with duplicates' ); ok( eq_hash( \%h, {1 => undef} ), "correct value stored" ); is( scalar(%h = (1,1,1)), 3, 'odd hash assignment in scalar context with duplicates' ); ok( eq_hash( \%h, {1 => undef} ), "correct value stored" ); is( join(':', ($x,%h) = (0,1,1,1) ), '0:1:', 'scalar + odd hash assignment in list context with duplicates' ); ok( eq_hash( \%h, {1 => undef} ), "correct value stored" ); is( scalar( ($x,%h) = (0,1,1,1) ), 4, 'scalar + odd hash assignment in scalar context with duplicates' ); ok( eq_hash( \%h, {1 => undef} ), "correct value stored" ); } # hash followed by more elements on LHS of list assignment # (%h, ...) = ...; { my (%h, %x, @x, $x); is( scalar( (%h,$x) = (1,2,3,4)), 4, 'hash+scalar assignment in scalar context' ); ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); is( $x, undef, "correct scalar" ); # this arguable, but this is how it works is( join(':', (%h,$x) = (1,2,3,4)), '1:2:3:4', 'hash+scalar assignment in list context' ); ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); is( $x, undef, "correct scalar" ); is( scalar( (%h,%x) = (1,2,3,4)), 4, 'hash+hash assignment in scalar context' ); ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); ok( eq_hash( \%x, {} ), "correct hash" ); is( join(':', (%h,%x) = (1,2,3,4)), '1:2:3:4', 'hash+hash assignment in list context' ); ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); ok( eq_hash( \%x, {} ), "correct hash" ); is( scalar( (%h,@x) = (1,2,3,4)), 4, 'hash+array assignment in scalar context' ); ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); ok( eq_array( \@x, [] ), "correct array" ); is( join(':', (%h,@x) = (1,2,3,4)), '1:2:3:4', 'hash+hash assignment in list context' ); ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" ); ok( eq_array( \@x, [] ), "correct array" ); } # hash followed by more elements on LHS of list assignment # and duplicates on RHS # (%h, ...) = (1)x10; { my (%h, %x, @x, $x); is( scalar( (%h,$x) = (1,2,1,4)), 4, 'hash+scalar assignment in scalar context' ); ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); is( $x, undef, "correct scalar" ); # this arguable, but this is how it works is( join(':', (%h,$x) = (1,2,1,4)), '1:4', 'hash+scalar assignment in list context' ); ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); is( $x, undef, "correct scalar" ); is( scalar( (%h,%x) = (1,2,1,4)), 4, 'hash+hash assignment in scalar context' ); ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); ok( eq_hash( \%x, {} ), "correct hash" ); is( join(':', (%h,%x) = (1,2,1,4)), '1:4', 'hash+hash assignment in list context' ); ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); ok( eq_hash( \%x, {} ), "correct hash" ); is( scalar( (%h,@x) = (1,2,1,4)), 4, 'hash+array assignment in scalar context' ); ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); ok( eq_array( \@x, [] ), "correct array" ); is( join(':', (%h,@x) = (1,2,1,4)), '1:4', 'hash+hash assignment in list context' ); ok( eq_hash( \%h, {1 => 4} ), "correct hash" ); ok( eq_array( \@x, [] ), "correct array" ); } # hash followed by more elements on LHS of list assignment # and duplicates with odd number of elements on RHS # (%h, ...) = (1,2,3,4,1); { no warnings 'misc'; # suppress oddball warnings my (%h, %x, @x, $x); is( scalar( (%h,$x) = (1,2,3,4,1)), 5, 'hash+scalar assignment in scalar context' ); ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); is( $x, undef, "correct scalar" ); # this arguable, but this is how it works is( join(':', map $_//'undef', (%h,$x) = (1,2,3,4,1)), '1:undef:3:4', 'hash+scalar assignment in list context' ); ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); is( $x, undef, "correct scalar" ); is( scalar( (%h,%x) = (1,2,3,4,1)), 5, 'hash+hash assignment in scalar context' ); ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); ok( eq_hash( \%x, {} ), "correct hash" ); is( join(':', map $_//'undef', (%h,%x) = (1,2,3,4,1)), '1:undef:3:4', 'hash+hash assignment in list context' ); ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); ok( eq_hash( \%x, {} ), "correct hash" ); is( scalar( (%h,@x) = (1,2,3,4,1)), 5, 'hash+array assignment in scalar context' ); ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); ok( eq_array( \@x, [] ), "correct array" ); is( join(':', map $_//'undef', (%h,@x) = (1,2,3,4,1)), '1:undef:3:4', 'hash+hash assignment in list context' ); ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" ); ok( eq_array( \@x, [] ), "correct array" ); } # not enough elements on rhs # ($x,$y,$z,...) = (1); { my ($x,$y,$z,@a,%h); is( join(':', ($x, $y, %h) = (1)), '1', 'only assigned elements are returned in list context'); is( join(':', ($x, $y, %h) = (1,1)), '1:1', 'only assigned elements are returned in list context'); no warnings 'misc'; # suppress oddball warnings is( join(':', map $_//'undef', ($x, $y, %h) = (1,1,1)), '1:1:1:undef', 'only assigned elements are returned in list context'); is( join(':', ($x, $y, %h) = (1,1,1,1)), '1:1:1:1', 'only assigned elements are returned in list context'); is( join(':', map $_//'undef', ($x, %h, $y) = (1,2,3,4)), '1:2:3:4:undef', 'only assigned elements are returned in list context'); is( join(':', ($x, $y, @h) = (1)), '1', 'only assigned elements are returned in list context'); is( join(':', ($x, @h, $y) = (1,2,3,4)), '1:2:3:4', 'only assigned elements are returned in list context'); } # lvaluedness of list context { my %h; my ($x, $y, $z); $_++ foreach %h = (1,2,3,4); ok( eq_hash( \%h, {1 => 3, 3 => 5} ), "aassign in list context returns lvalues" ); $_++ foreach %h = (1,2,1,4); ok( eq_hash( \%h, {1 => 5} ), "the same for assignment with duplicates" ); $_++ foreach ($x, %h) = (0,1,2,3,4); is( $x, 1, "... and leading scalar" ); ok( eq_hash( \%h, {1 => 3, 3 => 5} ), "... scalar followed by hash" ); { no warnings 'misc'; $_++ foreach %h = (1,2,3); ok( eq_hash( \%h, {1 => 3, 3 => 1} ), "odd elements also lvalued" ); } $x = 0; $_++ foreach %h = ($x,$x); is($x, 0, "returned values are not aliased to RHS of the assignment operation"); %h = (); $x = 0; $_++ foreach sub :lvalue { %h = ($x,$x) }->(); is($x, 0, "returned values are not aliased to RHS of assignment in lvalue sub"); $_++ foreach ($x,$y,%h,$z) = (0); ok( eq_array([$x,$y,%h,$z], [1,undef,undef]), "only assigned values are returned" ); $_++ foreach ($x,$y,%h,$z) = (0,1); ok( eq_array([$x,$y,%h,$z], [1,2,undef]), "only assigned values are returned" ); no warnings 'misc'; # suppress oddball warnings $_++ foreach ($x,$y,%h,$z) = (0,1,2); ok( eq_array([$x,$y,%h,$z], [1,2,2,1,undef]), "only assigned values are returned" ); }