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 # # test the bit operators '&', '|', '^', '~', '<<', and '>>' # BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require "./test.pl"; require Config; } # Tests don't have names yet. # If you find tests are failing, please try adding names to tests to track # down where the failure is, and supply your new names as a patch. # (Just-in-time test naming) plan tests => 174 + (10*13*2) + 5; # numerics ok ((0xdead & 0xbeef) == 0x9ead); ok ((0xdead | 0xbeef) == 0xfeef); ok ((0xdead ^ 0xbeef) == 0x6042); ok ((~0xdead & 0xbeef) == 0x2042); # shifts ok ((257 << 7) == 32896); ok ((33023 >> 7) == 257); # signed vs. unsigned ok ((~0 > 0 && do { use integer; ~0 } == -1)); my $bits = 0; for (my $i = ~0; $i; $i >>= 1) { ++$bits; } my $cusp = 1 << ($bits - 1); ok (($cusp & -1) > 0 && do { use integer; $cusp & -1 } < 0); ok (($cusp | 1) > 0 && do { use integer; $cusp | 1 } < 0); ok (($cusp ^ 1) > 0 && do { use integer; $cusp ^ 1 } < 0); ok ((1 << ($bits - 1)) == $cusp && do { use integer; 1 << ($bits - 1) } == -$cusp); ok (($cusp >> 1) == ($cusp / 2) && do { use integer; abs($cusp >> 1) } == ($cusp / 2)); $Aaz = chr(ord("A") & ord("z")); $Aoz = chr(ord("A") | ord("z")); $Axz = chr(ord("A") ^ ord("z")); # short strings is (("AAAAA" & "zzzzz"), ($Aaz x 5)); is (("AAAAA" | "zzzzz"), ($Aoz x 5)); is (("AAAAA" ^ "zzzzz"), ($Axz x 5)); # long strings $foo = "A" x 150; $bar = "z" x 75; $zap = "A" x 75; # & truncates is (($foo & $bar), ($Aaz x 75 )); # | does not truncate is (($foo | $bar), ($Aoz x 75 . $zap)); # ^ does not truncate is (($foo ^ $bar), ($Axz x 75 . $zap)); # string constants sub _and($) { $_[0] & "+0" } sub _oar($) { $_[0] | "+0" } sub _xor($) { $_[0] ^ "+0" } is _and "waf", '# ', 'str var & const str'; # These three is _and 0, '0', 'num var & const str'; # are from is _and "waf", '# ', 'str var & const str again'; # [perl #20661] is _oar "yit", '{yt', 'str var | const str'; is _oar 0, '0', 'num var | const str'; is _oar "yit", '{yt', 'str var | const str again'; is _xor "yit", 'RYt', 'str var ^ const str'; is _xor 0, '0', 'num var ^ const str'; is _xor "yit", 'RYt', 'str var ^ const str again'; # But don’t mistake a COW for a constant when assigning to it %h=(150=>1); $i=(keys %h)[0]; $i |= 105; is $i, 255, '[perl #108480] $cow |= number'; $i=(keys %h)[0]; $i &= 105; is $i, 0, '[perl #108480] $cow &= number'; $i=(keys %h)[0]; $i ^= 105; is $i, 255, '[perl #108480] $cow ^= number'; # is ("ok \xFF\xFF\n" & "ok 19\n", "ok 19\n"); is ("ok 20\n" | "ok \0\0\n", "ok 20\n"); is ("o\000 \0001\000" ^ "\000k\0002\000\n", "ok 21\n"); # is ("ok \x{FF}\x{FF}\n" & "ok 22\n", "ok 22\n"); is ("ok 23\n" | "ok \x{0}\x{0}\n", "ok 23\n"); is ("o\x{0} \x{0}4\x{0}" ^ "\x{0}k\x{0}2\x{0}\n", "ok 24\n"); # is (sprintf("%vd", v4095 & v801), 801); is (sprintf("%vd", v4095 | v801), 4095); is (sprintf("%vd", v4095 ^ v801), 3294); # is (sprintf("%vd", v4095.801.4095 & v801.4095), '801.801'); is (sprintf("%vd", v4095.801.4095 | v801.4095), '4095.4095.4095'); is (sprintf("%vd", v801.4095 ^ v4095.801.4095), '3294.3294.4095'); # is (sprintf("%vd", v120.300 & v200.400), '72.256'); is (sprintf("%vd", v120.300 | v200.400), '248.444'); is (sprintf("%vd", v120.300 ^ v200.400), '176.188'); # my $a = v120.300; my $b = v200.400; $a ^= $b; is (sprintf("%vd", $a), '176.188'); my $a = v120.300; my $b = v200.400; $a |= $b; is (sprintf("%vd", $a), '248.444'); # # UTF8 ~ behaviour # my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0; my @not36; for (0x100...0xFFF) { $a = ~(chr $_); if ($Is_EBCDIC) { push @not36, sprintf("%#03X", $_) if $a ne chr(~$_) or length($a) != 1; } else { push @not36, sprintf("%#03X", $_) if $a ne chr(~$_) or length($a) != 1 or ~$a ne chr($_); } } is (join (', ', @not36), ''); my @not37; for my $i (0xEEE...0xF00) { for my $j (0x0..0x120) { $a = ~(chr ($i) . chr $j); if ($Is_EBCDIC) { push @not37, sprintf("%#03X %#03X", $i, $j) if $a ne chr(~$i).chr(~$j) or length($a) != 2; } else { push @not37, sprintf("%#03X %#03X", $i, $j) if $a ne chr(~$i).chr(~$j) or length($a) != 2 or ~$a ne chr($i).chr($j); } } } is (join (', ', @not37), ''); SKIP: { skip "EBCDIC" if $Is_EBCDIC; is (~chr(~0), "\0"); } my @not39; for my $i (0x100..0x120) { for my $j (0x100...0x120) { push @not39, sprintf("%#03X %#03X", $i, $j) if ~(chr($i)|chr($j)) ne (~chr($i)&~chr($j)); } } is (join (', ', @not39), ''); my @not40; for my $i (0x100..0x120) { for my $j (0x100...0x120) { push @not40, sprintf("%#03X %#03X", $i, $j) if ~(chr($i)&chr($j)) ne (~chr($i)|~chr($j)); } } is (join (', ', @not40), ''); # More variations on 19 and 22. is ("ok \xFF\x{FF}\n" & "ok 41\n", "ok 41\n"); is ("ok \x{FF}\xFF\n" & "ok 42\n", "ok 42\n"); # Tests to see if you really can do casts negative floats to unsigned properly $neg1 = -1.0; ok (~ $neg1 == 0); $neg7 = -7.0; ok (~ $neg7 == 6); # double magic tests sub TIESCALAR { bless { value => $_[1], orig => $_[1] } } sub STORE { $_[0]{store}++; $_[0]{value} = $_[1] } sub FETCH { $_[0]{fetch}++; $_[0]{value} } sub stores { tied($_[0])->{value} = tied($_[0])->{orig}; delete(tied($_[0])->{store}) || 0 } sub fetches { delete(tied($_[0])->{fetch}) || 0 } # numeric double magic tests tie $x, "main", 1; tie $y, "main", 3; is(($x | $y), 3); is(fetches($x), 1); is(fetches($y), 1); is(stores($x), 0); is(stores($y), 0); is(($x & $y), 1); is(fetches($x), 1); is(fetches($y), 1); is(stores($x), 0); is(stores($y), 0); is(($x ^ $y), 2); is(fetches($x), 1); is(fetches($y), 1); is(stores($x), 0); is(stores($y), 0); is(($x |= $y), 3); is(fetches($x), 2); is(fetches($y), 1); is(stores($x), 1); is(stores($y), 0); is(($x &= $y), 1); is(fetches($x), 2); is(fetches($y), 1); is(stores($x), 1); is(stores($y), 0); is(($x ^= $y), 2); is(fetches($x), 2); is(fetches($y), 1); is(stores($x), 1); is(stores($y), 0); is(~~$y, 3); is(fetches($y), 1); is(stores($y), 0); { use integer; is(($x | $y), 3); is(fetches($x), 1); is(fetches($y), 1); is(stores($x), 0); is(stores($y), 0); is(($x & $y), 1); is(fetches($x), 1); is(fetches($y), 1); is(stores($x), 0); is(stores($y), 0); is(($x ^ $y), 2); is(fetches($x), 1); is(fetches($y), 1); is(stores($x), 0); is(stores($y), 0); is(($x |= $y), 3); is(fetches($x), 2); is(fetches($y), 1); is(stores($x), 1); is(stores($y), 0); is(($x &= $y), 1); is(fetches($x), 2); is(fetches($y), 1); is(stores($x), 1); is(stores($y), 0); is(($x ^= $y), 2); is(fetches($x), 2); is(fetches($y), 1); is(stores($x), 1); is(stores($y), 0); is(~$y, -4); is(fetches($y), 1); is(stores($y), 0); } # end of use integer; # stringwise double magic tests tie $x, "main", "a"; tie $y, "main", "c"; is(($x | $y), ("a" | "c")); is(fetches($x), 1); is(fetches($y), 1); is(stores($x), 0); is(stores($y), 0); is(($x & $y), ("a" & "c")); is(fetches($x), 1); is(fetches($y), 1); is(stores($x), 0); is(stores($y), 0); is(($x ^ $y), ("a" ^ "c")); is(fetches($x), 1); is(fetches($y), 1); is(stores($x), 0); is(stores($y), 0); is(($x |= $y), ("a" | "c")); is(fetches($x), 2); is(fetches($y), 1); is(stores($x), 1); is(stores($y), 0); is(($x &= $y), ("a" & "c")); is(fetches($x), 2); is(fetches($y), 1); is(stores($x), 1); is(stores($y), 0); is(($x ^= $y), ("a" ^ "c")); is(fetches($x), 2); is(fetches($y), 1); is(stores($x), 1); is(stores($y), 0); is(~~$y, "c"); is(fetches($y), 1); is(stores($y), 0); $a = "\0\x{100}"; chop($a); ok(utf8::is_utf8($a)); # make sure UTF8 flag is still there $a = ~$a; is($a, "\xFF", "~ works with utf-8"); # [rt.perl.org 33003] # This would cause a segfault without malloc wrap SKIP: { skip "No malloc wrap checks" unless $Config::Config{usemallocwrap}; like( runperl(prog => 'eval q($#a>>=1); print 1'), "^1\n?" ); } # [perl #37616] Bug in &= (string) and/or m// { $a = "aa"; $a &= "a"; ok($a =~ /a+$/, 'ASCII "a" is NUL-terminated'); $b = "bb\x{100}"; $b &= "b"; ok($b =~ /b+$/, 'Unicode "b" is NUL-terminated'); } { $a = chr(0x101) x 0x101; $b = chr(0x0FF) x 0x0FF; $c = $a | $b; is($c, chr(0x1FF) x 0xFF . chr(0x101) x 2); $c = $b | $a; is($c, chr(0x1FF) x 0xFF . chr(0x101) x 2); $c = $a & $b; is($c, chr(0x001) x 0x0FF); $c = $b & $a; is($c, chr(0x001) x 0x0FF); $c = $a ^ $b; is($c, chr(0x1FE) x 0x0FF . chr(0x101) x 2); $c = $b ^ $a; is($c, chr(0x1FE) x 0x0FF . chr(0x101) x 2); } { $a = chr(0x101) x 0x101; $b = chr(0x0FF) x 0x0FF; $a |= $b; is($a, chr(0x1FF) x 0xFF . chr(0x101) x 2); } { $a = chr(0x101) x 0x101; $b = chr(0x0FF) x 0x0FF; $b |= $a; is($b, chr(0x1FF) x 0xFF . chr(0x101) x 2); } { $a = chr(0x101) x 0x101; $b = chr(0x0FF) x 0x0FF; $a &= $b; is($a, chr(0x001) x 0x0FF); } { $a = chr(0x101) x 0x101; $b = chr(0x0FF) x 0x0FF; $b &= $a; is($b, chr(0x001) x 0x0FF); } { $a = chr(0x101) x 0x101; $b = chr(0x0FF) x 0x0FF; $a ^= $b; is($a, chr(0x1FE) x 0x0FF . chr(0x101) x 2); } { $a = chr(0x101) x 0x101; $b = chr(0x0FF) x 0x0FF; $b ^= $a; is($b, chr(0x1FE) x 0x0FF . chr(0x101) x 2); } # update to pp_complement() via Coverity SKIP: { # UTF-EBCDIC is limited to 0x7fffffff and can't encode ~0. skip "EBCDIC" if $Is_EBCDIC; my $str = "\x{10000}\x{800}"; # U+10000 is four bytes in UTF-8/UTF-EBCDIC. # U+0800 is three bytes in UTF-8/UTF-EBCDIC. no warnings "utf8"; { use bytes; $str =~ s/\C\C\z//; } # it's really bogus that (~~malformed) is \0. my $ref = "\x{10000}\0"; is(~~$str, $ref); # same test, but this time with a longer replacement string that # exercises a different branch in pp_subsr() $str = "\x{10000}\x{800}"; { use bytes; $str =~ s/\C\C\z/\0\0\0/; } # it's also bogus that (~~malformed) is \0\0\0\0. my $ref = "\x{10000}\0\0\0\0"; is(~~$str, $ref, "use bytes with long replacement"); } # ref tests my %res; for my $str ("x", "\x{100}") { for my $chr (qw/S A H G X ( * F/) { for my $op (qw/| & ^/) { my $co = ord $chr; my $so = ord $str; $res{"$chr$op$str"} = eval qq/chr($co $op $so)/; } } $res{"undef|$str"} = $str; $res{"undef&$str"} = ""; $res{"undef^$str"} = $str; } sub PVBM () { "X" } index "foo", PVBM; my $warn = 0; local $^W = 1; local $SIG{__WARN__} = sub { $warn++ }; sub is_first { my ($got, $orig, $op, $str, $name) = @_; is(substr($got, 0, 1), $res{"$orig$op$str"}, $name); } for ( # [object to test, first char of stringification, name] [undef, "undef", "undef" ], [\1, "S", "scalar ref" ], [[], "A", "array ref" ], [{}, "H", "hash ref" ], [qr/x/, "(", "qr//" ], [*foo, "*", "glob" ], [\*foo, "G", "glob ref" ], [PVBM, "X", "PVBM" ], [\PVBM, "S", "PVBM ref" ], [bless([], "Foo"), "F", "object" ], ) { my ($val, $orig, $type) = @$_; for (["x", "string"], ["\x{100}", "utf8"]) { my ($str, $desc) = @$_; $warn = 0; is_first($val | $str, $orig, "|", $str, "$type | $desc"); is_first($val & $str, $orig, "&", $str, "$type & $desc"); is_first($val ^ $str, $orig, "^", $str, "$type ^ $desc"); is_first($str | $val, $orig, "|", $str, "$desc | $type"); is_first($str & $val, $orig, "&", $str, "$desc & $type"); is_first($str ^ $val, $orig, "^", $str, "$desc ^ $type"); my $new; ($new = $val) |= $str; is_first($new, $orig, "|", $str, "$type |= $desc"); ($new = $val) &= $str; is_first($new, $orig, "&", $str, "$type &= $desc"); ($new = $val) ^= $str; is_first($new, $orig, "^", $str, "$type ^= $desc"); ($new = $str) |= $val; is_first($new, $orig, "|", $str, "$desc |= $type"); ($new = $str) &= $val; is_first($new, $orig, "&", $str, "$desc &= $type"); ($new = $str) ^= $val; is_first($new, $orig, "^", $str, "$desc ^= $type"); if ($orig eq "undef") { # undef |= and undef ^= don't warn is($warn, 10, "no duplicate warnings"); } else { is($warn, 0, "no warnings"); } } } my $strval; { package Bar; use overload q/""/ => sub { $strval }; package Baz; use overload q/|/ => sub { "y" }; } ok(!eval { bless([], "Bar") | "x"; 1 }, "string overload can't use |"); like($@, qr/no method found/, "correct error"); is(eval { bless([], "Baz") | "x" }, "y", "| overload works"); my $obj = bless [], "Bar"; $strval = "x"; eval { $obj |= "Q" }; $strval = "z"; is("$obj", "z", "|= doesn't break string overload"); # [perl #29070] $^A .= new version ~$_ for "\xce", v205, "\xcc"; is $^A, "123", '~v0 clears vstring magic on retval';