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