t/japh/abigail.t

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