t/japh/abigail.t

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