1#!./perl -w 2 3# 4# Tests derived from Japhs. 5# 6# These test use obscure features of Perl, or surprising combinations 7# of features. The tests were added because in the past, they have 8# exposed several bugs in Perl. 9# 10# Some of these tests may actually (mis)use bugs or use undefined behaviour. 11# These tests are still useful - behavioural changes or bugfixes will be 12# noted, and a remark can be put in the documentation. (Don't forget to 13# disable the test!) 14# 15# Getting everything to run well on the myriad of platforms Perl runs on 16# is unfortunately not a trivial task. 17# 18# WARNING: these tests are obfuscated. Do not get frustrated. 19# Ask Abigail <abigail@abigail.be>, or use the Deparse or Concise 20# modules (the former parses Perl to Perl, the latter shows the 21# op syntax tree) like this: 22# ./perl -Ilib -MO=Deparse foo.pl 23# ./perl -Ilib -MO=Concise foo.pl 24# 25 26BEGIN { 27 chdir 't' if -d 't'; 28 @INC = '../lib'; 29 require "./test.pl"; 30 skip_all('EBCDIC') if $::IS_EBCDIC; 31 undef &skip; 32} 33 34# 35# ./test.pl does real evilness by jumping to a label. 36# This function copies the skip from ./test, omitting the goto. 37# 38sub skip { 39 my $why = shift; 40 my $n = @_ ? shift : 1; 41 for (1..$n) { 42 my $test = curr_test; 43 print STDOUT "ok $test # skip: $why\n"; 44 next_test; 45 } 46} 47 48 49# 50# ./test.pl doesn't give use 'notok', so we make it here. 51# 52sub notok { 53 my ($pass, $name, @mess) = @_; 54 _ok(!$pass, _where(), $name, @mess); 55} 56 57my $JaPH = "Just another Perl Hacker"; 58my $JaPh = "Just another Perl hacker"; 59my $JaPH_n = "Just another Perl Hacker\n"; 60my $JaPh_n = "Just another Perl hacker\n"; 61my $JaPH_s = "Just another Perl Hacker "; 62my $JaPh_s = "Just another Perl hacker "; 63my $JaPH_c = "Just another Perl Hacker,"; 64my $JaPh_c = "Just another Perl hacker,"; 65 66plan tests => 130; 67 68{ 69 my $out = sprintf "Just another Perl Hacker"; 70 is ($out, $JaPH); 71} 72 73 74{ 75 my @primes = (2, 3, 7, 13, 53, 101, 557, 1429); 76 my @composites = (4, 10, 25, 32, 75, 143, 1333, 1728); 77 78 my %primeness = ((map {$_ => 1} @primes), 79 (map {$_ => 0} @composites)); 80 81 while (my ($num, $is_prime) = each %primeness) { 82 my $comment = "$num is " . ($is_prime ? "prime." : "composite."); 83 84 my $sub = $is_prime ? "ok" : "notok"; 85 86 &$sub (( 1 x $num) !~ /^1?$|^(11+?)\1+$/, $comment); 87 &$sub (( 0 x $num) !~ m 0^\0?$|^(\0\0+?)\1+$0, $comment); 88 &$sub (("m" x $num) !~ m m^\m?$|^(\m\m+?)\1+$mm, $comment); 89 } 90} 91 92 93{ # Some platforms use different quoting techniques. 94 # I do not have access to those platforms to test 95 # things out. So, we'll skip things.... 96 if ($^O eq 'MSWin32' || 97 $^O eq 'VMS') { 98 skip "Your platform quotes differently.", 3; 99 last; 100 } 101 102 my $expected = $JaPH; 103 $expected =~ s/ /\n/g; 104 $expected .= "\n"; 105 is (runperl (switches => [qw /'-weprint<<EOT;' -eJust -eanother 106 -ePerl -eHacker -eEOT/], 107 verbose => 0), 108 $expected, "Multiple -e switches"); 109 110 is (runperl (switches => [q !'-wle$_=<<EOT;y/\n/ /;print;'!, 111 qw ! -eJust -eanother -ePerl -eHacker -eEOT!], 112 verbose => 0), 113 $JaPH . " \n", "Multiple -e switches"); 114 115 is (runperl (switches => [qw !-wl!], 116 progs => [qw !print qq-@{[ qw+ Just 117 another Perl Hacker +]}-!], 118 verbose => 0), 119 $JaPH_n, "Multiple -e switches"); 120} 121 122{ 123 if ($^O eq 'MSWin32' || 124 $^O eq 'VMS') { 125 skip "Your platform quotes differently.", 1; 126 last; 127 } 128 is (runperl (switches => [qw /-sweprint --/, 129 "-_='Just another Perl Hacker'"], 130 nolib => 1, 131 verbose => 0), 132 $JaPH, 'setting $_ via -s'); 133} 134 135{ 136 my $datafile = "datatmp000"; 137 1 while -f ++ $datafile; 138 END {unlink_all $datafile if $datafile} 139 140 open MY_DATA, "> $datafile" or die "Failed to open $datafile: $!"; 141 print MY_DATA << " --"; 142 One 143 Two 144 Three 145 Four 146 Five 147 Six 148 -- 149 close MY_DATA or die "Failed to close $datafile: $!\n"; 150 151 my @progs; 152 my $key; 153 while (<DATA>) { 154 last if /^__END__$/; 155 156 if (/^#{7}(?:\s+(.*))?/) { 157 push @progs => {COMMENT => $1 || '', 158 CODE => '', 159 SKIP_OS => [], 160 ARGS => [], 161 SWITCHES => [],}; 162 $key = 'CODE'; 163 next; 164 } 165 elsif (/^(COMMENT|CODE|ARGS|SWITCHES|EXPECT|SKIP|SKIP_OS) 166 (?::\s+(.*))?$/sx) { 167 $key = $1; 168 $progs [-1] {$key} = '' unless exists $progs [-1] {$key}; 169 next unless defined $2; 170 $_ = $2; 171 } 172 elsif (/^$/) { 173 next; 174 } 175 176 if (ref ($progs [-1] {$key})) { 177 push @{$progs [-1] {$key}} => $_; 178 } 179 else { 180 $progs [-1] {$key} .= $_; 181 } 182 } 183 184 foreach my $program (@progs) { 185 if (exists $program -> {SKIP}) { 186 chomp $program -> {SKIP}; 187 skip $program -> {SKIP}, 1; 188 next; 189 } 190 191 chomp @{$program -> {SKIP_OS}}; 192 if (@{$program -> {SKIP_OS}}) { 193 if (grep {$^O eq $_} @{$program -> {SKIP_OS}}) { 194 skip "Your OS uses different quoting.", 1; 195 next; 196 } 197 } 198 199 map {s/\$datafile/$datafile/} @{$program -> {ARGS}}; 200 $program -> {EXPECT} = $JaPH unless exists $program -> {EXPECT}; 201 $program -> {EXPECT} =~ s/\$JaPH_s\b/$JaPH_s/g; 202 $program -> {EXPECT} =~ s/\$JaPh_c\b/$JaPh_c/g; 203 $program -> {EXPECT} =~ s/\$JaPh\b/$JaPh/g; 204 chomp ($program -> {EXPECT}, @{$program -> {SWITCHES}}, 205 @{$program -> {ARGS}}); 206 fresh_perl_is ($program -> {CODE}, 207 $program -> {EXPECT}, 208 {switches => $program -> {SWITCHES}, 209 args => $program -> {ARGS}, 210 verbose => 0}, 211 $program -> {COMMENT}); 212 } 213} 214 215{ 216 my $progfile = "progtmp000"; 217 1 while -f ++ $progfile; 218 END {unlink_all $progfile if $progfile} 219 220 my @programs = (<< ' --', << ' --'); 221#!./perl 222BEGIN{$|=$SIG{__WARN__}=sub{$_=$_[0];y-_- -;print/(.)"$/;seek _,-open(_ 223,"+<$0"),2;truncate _,tell _;close _;exec$0}}//rekcaH_lreP_rehtona_tsuJ 224 -- 225#!./perl 226BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/; 227truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ 228 -- 229 chomp @programs; 230 231 if ($^O eq 'VMS' or $^O eq 'MSWin32') { 232 # VMS needs extensions for files to be executable, 233 # but the Japhs above rely on $0 being exactly the 234 # filename of the program. 235 skip $^O, 2 * @programs; 236 last 237 } 238 239 use Config; 240 unless (defined $Config {useperlio}) { 241 skip "Uuseperlio", 2 * @programs; 242 last 243 } 244 245 my $i = 1; 246 foreach my $program (@programs) { 247 open my $fh => "> $progfile" or die "Failed to open $progfile: $!\n"; 248 print $fh $program; 249 close $fh or die "Failed to close $progfile: $!\n"; 250 251 chmod 0755 => $progfile or die "Failed to chmod $progfile: $!\n"; 252 my $command = "./$progfile 2>&1"; 253 if ( $^O eq 'qnx' ) { 254 skip "#!./perl not supported in QNX4"; 255 skip "#!./perl not supported in QNX4"; 256 } else { 257 my $output = `$command`; 258 259 is ($output, $JaPH, "Self correcting code $i"); 260 261 $output = `$command`; 262 is ($output, "", "Self corrected code $i"); 263 } 264 $i ++; 265 } 266} 267 268__END__ 269####### Funky loop 1. 270$_ = q ;4a75737420616e6f74686572205065726c204861636b65720as;; 271 for (s;s;s;s;s;s;s;s;s;s;s;s) 272 {s;(..)s?;qq qprint chr 0x$1 and \161 ssq;excess;} 273 274####### Funky loop 2. 275$_ = q *4a75737420616e6f74686572205065726c204861636b65720a*; 276for ($*=******;$**=******;$**=******) {$**=*******s*..*qq} 277print chr 0x$& and q 278qq}*excess********} 279SKIP: $* was removed. 280 281####### Funky loop 3. 282$_ = q *4a75737420616e6f74686572205065726c204861636b65720a*; 283for ($*=******;$**=******;$**=******) {$**=*******s*..*qq} 284print chr 0x$& and q 285qq}*excess********} 286SKIP: $* was removed. 287 288####### Funky loop 4. 289$_ = q ?4a75737420616e6f74686572205065726c204861636b65720as?;??; 290for (??;(??)x??;??) 291 {??;s;(..)s?;qq ?print chr 0x$1 and \161 ss?;excess;??} 292SKIP: Abuses a fixed bug. 293 294####### Funky loop 5. 295for (s??4a75737420616e6f74686572205065726c204861636b65720as?;??;??) 296 {s?(..)s\??qq \?print chr 0x$1 and q ss\??excess} 297SKIP: Abuses a fixed bug. 298 299####### Funky loop 6. 300$a = q 94a75737420616e6f74686572205065726c204861636b65720a9 and 301${qq$\x5F$} = q 97265646f9 and s g..g; 302qq e\x63\x68\x72\x20\x30\x78$&eggee; 303{eval if $a =~ s e..eqq qprint chr 0x$& and \x71\x20\x71\x71qeexcess} 304 305####### Roman Dates. 306@r=reverse(M=>(0)x99=>CM=>(0)x399=>D=>(0)x99=>CD=>( 3070)x299=>C=>(0)x9=>XC=>(0)x39=>L=>(0)x9=>XL=>(0)x29=>X=>IX=>0=>0=>0=>V=>IV=>0=>0 308=>I=>$==-2449231+gm_julian_day+time);do{until($=<$#r){$_.=$r[$#r];$=-=$#r}for(; 309!$r[--$#r];){}}while$=;$,="\x20";print+$_=>September=>MCMXCIII=>=>=>=>=>=>=>=> 310SWITCHES 311-MTimes::JulianDay 312-l 313SKIP: Times::JulianDay not part of the main distribution. 314 315####### Autoload 1. 316sub _'_{$_'_=~s/$a/$_/}map{$$_=$Z++}Y,a..z,A..X;*{($_::_=sprintf+q=%X==>"$A$Y". 317"$b$r$T$u")=~s~0~O~g;map+_::_,U=>T=>L=>$Z;$_::_}=*_;sub _{print+/.*::(.*)/s};;; 318*{chr($b*$e)}=*_'_;*__=*{chr(1<<$e)}; # Perl 5.6.0 broke this... 319_::_(r(e(k(c(a(H(__(l(r(e(P(__(r(e(h(t(o(n(a(__(t(us(J()))))))))))))))))))))))) 320EXPECT: Just__another__Perl__Hacker 321 322####### Autoload 2. 323$"=$,;*{;qq{@{[(A..Z)[qq[0020191411140003]=~m[..]g]]}}}=*_=sub{print/::(.*)/}; 324$\=$/;q<Just another Perl Hacker>->(); 325 326####### Autoload 3. 327$"=$,;*{;qq{@{[(A..Z)[qq[0020191411140003]=~m[..]g]]}}}=*_; 328sub _ {push @_ => /::(.*)/s and goto &{ shift}} 329sub shift {print shift; @_ and goto &{+shift}} 330Hack ("Just", "Perl ", " ano", "er\n", "ther "); # YYYYMMDD 331 332####### Autoload 4. 333$, = " "; sub AUTOLOAD {($AUTOLOAD =~ /::(.*)/) [0];} 334print+Just (), another (), Perl (), Hacker (); 335 336####### Look ma! No letters! 337$@="\145\143\150\157\040\042\112\165\163\164\040\141\156\157\164". 338 "\150\145\162\040\120\145\162\154\040\110\141\143\153\145\162". 339 "\042\040\076\040\057\144\145\166\057\164\164\171";`$@` 340SKIP: Unix specific 341 342####### sprintf fun 1. 343sub f{sprintf$_[0],$_[1],$_[2]}print f('%c%s',74,f('%c%s',117,f('%c%s',115,f( 344'%c%s',116,f('%c%s',32,f('%c%s',97,f('%c%s',0x6e,f('%c%s',111,f('%c%s',116,f( 345'%c%s',104,f('%c%s',0x65,f('%c%s',114,f('%c%s',32,f('%c%s',80,f('%c%s',101,f( 346'%c%s',114,f('%c%s',0x6c,f('%c%s',32,f('%c%s',0x48,f('%c%s',97,f('%c%s',99,f( 347'%c%s',107,f('%c%s',101,f('%c%s',114,f('%c%s',10,))))))))))))))))))))))))) 348 349####### sprintf fun 2. 350sub f{sprintf'%c%s',$_[0],$_[1]}print f(74,f(117,f(115,f(116,f(32,f(97, 351f(110,f(111,f(116,f(104,f(0x65,f(114,f(32,f(80,f(101,f(114,f(0x6c,f(32, 352f(0x48,f(97,f(99,f(107,f(101,f(114,f(10,q ff))))))))))))))))))))))))) 353 354####### Hanoi. 355%0=map{local$_=$_;reverse+chop,$_}ABC,ACB,BAC,BCA,CAB,CBA;$_=3 .AC;1while+ 356s/(\d+)((.)(.))/($0=$1-1)?"$0$3$0{$2}1$2$0$0{$2}$4":"$3 => $4\n"/xeg;print 357EXPECT 358A => C 359A => B 360C => B 361A => C 362B => A 363B => C 364A => C 365 366####### Funky -p 1 367}{$_=$. 368SWITCHES: -wlp 369ARGS: $datafile 370EXPECT: 6 371 372####### Funky -p 2 373}$_=$.;{ 374SWITCHES: -wlp 375ARGS: $datafile 376EXPECT: 6 377 378####### Funky -p 3 379}{$_=$.}{ 380SWITCHES: -wlp 381ARGS: $datafile 382EXPECT: 6 383 384####### Funky -p 4 385}{*_=*.}{ 386SWITCHES: -wlp 387ARGS: $datafile 388EXPECT: 6 389 390####### Funky -p 5 391}for($.){print 392SWITCHES: -wln 393ARGS: $datafile 394EXPECT: 6 395 396####### Funky -p 6 397}{print$. 398SWITCHES: -wln 399ARGS: $datafile 400EXPECT: 6 401 402####### Funky -p 7 403}print$.;{ 404SWITCHES: -wln 405ARGS: $datafile 406EXPECT: 6 407 408####### Abusing -M 4091 410SWITCHES 411-Mstrict='}); print "Just another Perl Hacker"; ({' 412-l 413SKIP: No longer works in 5.8.2 and beyond. 414SKIP_OS: MSWin32 415 416####### rand 417srand 123456;$-=rand$_--=>@[[$-,$_]=@[[$_,$-]for(reverse+1..(@[=split 418//=>"IGrACVGQ\x02GJCWVhP\x02PL\x02jNMP"));print+(map{$_^q^"^}@[),"\n" 419SKIP: Solaris specific. 420 421####### print and __PACKAGE__ 422package Just_another_Perl_Hacker; sub print {($_=$_[0])=~ s/_/ /g; 423 print } sub __PACKAGE__ { & 424 print ( __PACKAGE__)} & 425 __PACKAGE__ 426 ( ) 427 428####### Decorations. 429* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 430/ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / 431% % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %; 432BEGIN {% % = ($ _ = " " => print "Just another Perl Hacker\n")} 433 434####### Tie 1 435sub J::FETCH{Just }$_.='print+"@{[map';sub J::TIESCALAR{bless\my$J,J} 436sub A::FETCH{another}$_.='{tie my($x),$';sub A::TIESCALAR{bless\my$A,A} 437sub P::FETCH{Perl }$_.='_;$x}qw/J A P';sub P::TIESCALAR{bless\my$P,P} 438sub H::FETCH{Hacker }$_.=' H/]}\n"';eval;sub H::TIESCALAR{bless\my$H,H} 439 440####### Tie 2 441package Z;use overload'""'=>sub{$b++?Hacker:another}; 442sub TIESCALAR{bless\my$y=>Z}sub FETCH{$a++?Perl:Just} 443$,=$";my$x=tie+my$y=>Z;print$y,$x,$y,$x,"\n";#Abigail 444EXPECT: $JaPH_s 445 446####### Tie 3 447sub A::TIESCALAR{bless\my$x=>A};package B;@q[0..3]=qw/Hacker Perl 448another Just/;use overload'""'=>sub{pop @q};sub A::FETCH{bless\my 449$y=>B}; tie my $shoe => qq 'A';print "$shoe $shoe $shoe $shoe\n"; 450 451####### Tie 4 452sub A::TIESCALAR{bless\my$x=>'A'};package B;@q=qw/Hacker Perl 453another Just/;use overload'""',sub{pop @q};sub A::FETCH{bless 454\my $y=>B};tie my$shoe=>'A';print"$shoe $shoe $shoe $shoe\n"; 455 456####### Tie 5 457tie $" => A; $, = " "; $\ = "\n"; @a = ("") x 2; print map {"@a"} 1 .. 4; 458sub A::TIESCALAR {bless \my $A => A} # Yet Another silly JAPH by Abigail 459sub A::FETCH {@q = qw /Just Another Perl Hacker/ unless @q; shift @q} 460SKIP: Pending a bug fix. 461 462####### Prototype fun 1 463sub camel (^#87=i@J&&&#]u'^^s]#'#={123{#}7890t[0.9]9@+*`"'***}A&&&}n2o}00}t324i; 464h[{e **###{r{+P={**{e^^^#'#i@{r'^=^{l+{#}H***i[0.9]&@a5`"':&^;&^,*&^$43##@@####; 465c}^^^&&&k}&&&}#=e*****[]}'r####'`=437*{#};::'1[0.9]2@43`"'*#==[[.{{],,,1278@#@); 466print+((($llama=prototype'camel')=~y|+{#}$=^*&[0-9]i@:;`"',.| |d)&&$llama."\n"); 467SKIP: Abuses a fixed bug. 468 469####### Prototype fun 2 470print prototype sub "Just another Perl Hacker" {}; 471SKIP: Abuses a fixed bug. 472 473####### Prototype fun 3 474sub _ "Just another Perl Hacker"; print prototype \&_ 475SKIP: Abuses a fixed bug. 476 477####### Split 1 478 split // => '"'; 479${"@_"} = "/"; split // => eval join "+" => 1 .. 7; 480*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}}; 481%{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}}; 482SKIP: Hashes are now randomized. 483EXPECT: $JaPH_s 484 485####### Split 2 486$" = "/"; split // => eval join "+" => 1 .. 7; 487*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}}; 488%_ = (Just => another => Perl => Hacker); &{%_}; 489SKIP: Hashes are now randomized. 490EXPECT: $JaPH_s 491 492####### Split 3 493$" = "/"; split $, => eval join "+" => 1 .. 7; 494*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}}; 495%{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}}; 496SKIP: Hashes are now randomized. 497EXPECT: $JaPH_s 498 499####### Here documents 1 500$_ = "\x3C\x3C\x45\x4F\x54"; s/<<EOT/<<EOT/e; print; 501Just another Perl Hacker 502EOT 503 504####### Here documents 2 505$_ = "\x3C\x3C\x45\x4F\x54"; 506print if s/<<EOT/<<EOT/e; 507Just another Perl Hacker 508EOT 509 510####### Here documents 3 511$_ = "\x3C\x3C\x45\x4F\x54" and s/<<EOT/<<EOT/e and print; 512Just another Perl Hacker 513EOT 514 515####### Here documents 4 516$_ = "\x3C\x3C\x45\x4F\x54\n" and s/<<EOT/<<EOT/ee and print; 517"Just another Perl Hacker" 518EOT 519 520####### Self modifying code 1 521$_ = "goto F.print chop;\n=rekcaH lreP rehtona tsuJ";F1:eval 522SWITCHES: -w 523 524####### Overloaded constants 1 525BEGIN {$^H {q} = sub {pop and pop and print pop}; $^H = 2**4.2**12} 526"Just "; "another "; "Perl "; "Hacker"; 527SKIP_OS: qnx 528 529####### Overloaded constants 2 530BEGIN {$^H {q} = sub {$_ [1] =~ y/S-ZA-IK-O/q-tc-fe-m/d; $_ [1]}; $^H = 0x28100} 531print "Just another PYTHON hacker\n"; 532EXPECT: $JaPh 533 534####### Overloaded constants 3 535BEGIN {$^H {join "" => ("a" .. "z") [8, 13, 19, 4, 6, 4, 17]} = sub 536 {["", "Just ", "another ", "Perl ", "Hacker\n"] -> [shift]}; 537 $^H = hex join "" => reverse map {int ($_ / 2)} 0 .. 4} 538print 1, 2, 3, 4; 539 540####### Overloaded constants 4 541BEGIN {$^H {join "" => ("a" .. "z") [8, 13, 19, 4, 6, 4, 17]} = sub 542 {["", "Just ", "another ", "Perl ", "Hacker"] -> [shift]}; 543 $^H = hex join "" => reverse map {int ($_ / 2)} 0 .. 4} 544print 1, 2, 3, 4, "\n"; 545 546####### Overloaded constants 5 547BEGIN {my $x = "Knuth heals rare project\n"; 548 $^H {integer} = sub {my $y = shift; $_ = substr $x => $y & 0x1F, 1; 549 $y > 32 ? uc : lc}; $^H = hex join "" => 2, 1, 1, 0, 0} 550print 52,2,10,23,16,8,1,19,3,6,15,12,5,49,21,14,9,11,36,13,22,32,7,18,24; 551 552####### v-strings 1 553print v74.117.115.116.32; 554print v97.110.111.116.104.101.114.32; 555print v80.101.114.108.32; 556print v72.97.99.107.101.114.10; 557 558####### v-strings 2 559print 74.117.115.116.32; 560print 97.110.111.116.104.101.114.32; 561print 80.101.114.108.32; 562print 72.97.99.107.101.114.10; 563 564####### v-strings 3 565print v74.117.115.116.32, v97.110.111.116.104.101.114.32, 566 v80.101.114.108.32, v72.97.99.107.101.114.10; 567 568####### v-strings 4 569print 74.117.115.116.32, 97.110.111.116.104.101.114.32, 570 80.101.114.108.32, 72.97.99.107.101.114.10; 571 572####### v-strings 5 573print v74.117.115.116.32.97.110.111.116.104.101.114. 574 v32.80.101.114.108.32.72.97.99.107.101.114.10; 575 576####### v-strings 6 577print 74.117.115.116.32.97.110.111.116.104.101.114. 578 32.80.101.114.108.32.72.97.99.107.101.114.10; 579 580####### Symbolic references. 581map{${+chr}=chr}map{$_=>$_^ord$"}$=+$]..3*$=/2; 582print "$J$u$s$t $a$n$o$t$h$e$r $P$e$r$l $H$a$c$k$e$r\n"; 583 584####### $; fun 585$; # A lone dollar? 586=$"; # Pod? 587$; # The return of the lone dollar? 588{Just=>another=>Perl=>Hacker=>} # Bare block? 589=$/; # More pod? 590print%; # No right operand for %? 591 592####### @; fun 593@;=split//=>"Joel, Preach sartre knuth\n";$;=chr 65;%;=map{$;++=>$_} 5940,22,13,16,5,14,21,1,23,11,2,7,12,6,8,15,3,19,24,14,10,20,18,17,4,25 595;print@;[@;{A..Z}]; 596EXPECT: $JaPh_c 597 598####### %; fun 599$;=$";$;{Just=>another=>Perl=>Hacker=>}=$/;print%; 600 601####### &func; 602$_ = "\112\165\163\1648\141\156\157\164\150\145\1628\120\145" 603 . "\162\1548\110\141\143\153\145\162\0128\177" and &japh; 604sub japh {print "@_" and return if pop; split /\d/ and &japh} 605SKIP: As of 5.12.0, split() in void context no longer populates @_. 606 607####### magic goto. 608sub _ {$_ = shift and y/b-yB-Y/a-yB-Y/ xor !@ _? 609 exit print : 610 print and push @_ => shift and goto &{(caller (0)) [3]}} 611 split // => "KsvQtbuf fbsodpmu\ni flsI " xor & _ 612SKIP: As of 5.12.0, split() in void context no longer populates @_. 613 614####### $: fun 1 615:$:=~s:$":Just$&another$&:;$:=~s: 616:Perl$"Hacker$&:;chop$:;print$:#: 617 618####### $: fun 2 619 :;$:=~s: 620-:;another Perl Hacker 621 :;chop 622$:;$:=~y 623 :;::d;print+Just. 624$:; 625 626####### $: fun 3 627 :;$:=~s: 628-:;another Perl Hacker 629 :;chop 630$:;$:=~y:;::d;print+Just.$: 631 632####### $! 633s[$,][join$,,(split$,,($!=85))[(q[0006143730380126152532042307]. 634q[41342211132019313505])=~m[..]g]]e and y[yIbp][HJkP] and print; 635SKIP: Platform dependent. 636 637####### die 1 638eval {die ["Just another Perl Hacker"]}; print ${$@}[$#{@${@}}] 639 640####### die 2 641eval {die ["Just another Perl Hacker\n"]}; print ${$@}[$#{@${@}}] 642 643####### die 3 644eval {die ["Just another Perl Hacker"]}; print ${${@}}[$#{@{${@}}}] 645 646####### die 4 647eval {die ["Just another Perl Hacker\n"]}; print ${${@}}[$#{@{${@}}}] 648 649####### die 5 650eval {die [[qq [Just another Perl Hacker]]]};; print 651${${${@}}[$#{@{${@}}}]}[$#{${@{${@}}}[$#{@{${@}}}]}] 652SKIP: Abuses a fixed bug; what is in $#{...} must be an arrayref, not an array 653 654####### Closure returning itself. 655$_ = "\nrekcaH lreP rehtona tsuJ"; my $chop; $chop = sub {print chop; $chop}; 656$chop -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () 657-> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () 658 659####### Special blocks 1 660BEGIN {print "Just " } 661CHECK {print "another "} 662INIT {print "Perl " } 663END {print "Hacker\n"} 664 665####### Special blocks 2 666END {print "Hacker\n"} 667INIT {print "Perl " } 668CHECK {print "another "} 669BEGIN {print "Just " } 670 671####### Recursive regex. 672 my $qr = qr/^.+?(;).+?\1|;Just another Perl Hacker;|;.+$/; 673 $qr =~ s/$qr//g; 674print $qr, "\n"; 675 676####### use lib 'coderef' 677use lib sub {($\) = split /\./ => pop; print $"}; 678eval "use Just" || eval "use another" || eval "use Perl" || eval "use Hacker"; 679EXPECT 680 Just another Perl Hacker 681