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