This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
prevent calling recursing into S_concat_pat() for an empty array
[perl5.git] / 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     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 #
38 sub 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 #
52 sub notok {
53     my ($pass, $name, @mess) = @_;
54     _ok(!$pass, _where(), $name, @mess);
55 }
56
57 my $JaPH   = "Just another Perl Hacker";
58 my $JaPh   = "Just another Perl hacker";
59 my $JaPH_n = "Just another Perl Hacker\n";
60 my $JaPh_n = "Just another Perl hacker\n";
61 my $JaPH_s = "Just another Perl Hacker ";
62 my $JaPh_s = "Just another Perl hacker ";
63 my $JaPH_c = "Just another Perl Hacker,";
64 my $JaPh_c = "Just another Perl hacker,";
65
66 plan 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
222 BEGIN{$|=$SIG{__WARN__}=sub{$_=$_[0];y-_- -;print/(.)"$/;seek _,-open(_ 
223 ,"+<$0"),2;truncate _,tell _;close _;exec$0}}//rekcaH_lreP_rehtona_tsuJ
224     --
225 #!./perl
226 BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/;  
227 truncate$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*;
276 for ($*=******;$**=******;$**=******) {$**=*******s*..*qq}
277 print chr 0x$& and q
278 qq}*excess********}
279 SKIP: $* was removed.
280
281 #######  Funky loop 3.
282 $_ = q *4a75737420616e6f74686572205065726c204861636b65720a*;
283 for ($*=******;$**=******;$**=******) {$**=*******s*..*qq}
284 print chr 0x$& and q
285 qq}*excess********}
286 SKIP: $* was removed.
287
288 #######  Funky loop 4.
289 $_ = q ?4a75737420616e6f74686572205065726c204861636b65720as?;??;
290 for (??;(??)x??;??)
291     {??;s;(..)s?;qq ?print chr 0x$1 and \161 ss?;excess;??}
292 SKIP: Abuses a fixed bug.
293
294 #######  Funky loop 5.
295 for (s??4a75737420616e6f74686572205065726c204861636b65720as?;??;??) 
296     {s?(..)s\??qq \?print chr 0x$1 and q ss\??excess}
297 SKIP: Abuses a fixed bug.
298
299 #######  Funky loop 6.
300 $a = q 94a75737420616e6f74686572205065726c204861636b65720a9 and
301 ${qq$\x5F$} = q 97265646f9 and s g..g;
302 qq 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=>(
307 0)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=>=>=>=>=>=>=>=>
310 SWITCHES
311 -MTimes::JulianDay
312 -l
313 SKIP: Times::JulianDay not part of the main distribution.
314
315 #######  Autoload 1.
316 sub _'_{$_'_=~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())))))))))))))))))))))))
320 EXPECT: 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]]}}}=*_;
328 sub   _   {push         @_ => /::(.*)/s and goto &{ shift}}
329 sub shift {print shift; @_              and goto &{+shift}}
330 Hack ("Just", "Perl ", " ano", "er\n", "ther "); # YYYYMMDD
331
332 #######  Autoload 4.
333 $, = " "; sub AUTOLOAD {($AUTOLOAD =~ /::(.*)/) [0];}
334 print+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";`$@`
340 SKIP: Unix specific
341
342 #######  sprintf fun 1.
343 sub 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.
350 sub f{sprintf'%c%s',$_[0],$_[1]}print f(74,f(117,f(115,f(116,f(32,f(97,
351 f(110,f(111,f(116,f(104,f(0x65,f(114,f(32,f(80,f(101,f(114,f(0x6c,f(32,
352 f(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+
356 s/(\d+)((.)(.))/($0=$1-1)?"$0$3$0{$2}1$2$0$0{$2}$4":"$3 => $4\n"/xeg;print
357 EXPECT
358 A => C
359 A => B
360 C => B
361 A => C
362 B => A
363 B => C
364 A => C
365
366 #######  Funky -p 1
367 }{$_=$.
368 SWITCHES: -wlp
369 ARGS:     $datafile
370 EXPECT:   6
371
372 #######  Funky -p 2
373 }$_=$.;{
374 SWITCHES: -wlp
375 ARGS:     $datafile
376 EXPECT:   6
377
378 #######  Funky -p 3
379 }{$_=$.}{
380 SWITCHES: -wlp
381 ARGS:     $datafile
382 EXPECT:   6
383
384 #######  Funky -p 4
385 }{*_=*.}{
386 SWITCHES: -wlp
387 ARGS:     $datafile
388 EXPECT:   6
389
390 #######  Funky -p 5
391 }for($.){print
392 SWITCHES: -wln
393 ARGS:     $datafile
394 EXPECT:   6
395
396 #######  Funky -p 6
397 }{print$.
398 SWITCHES: -wln
399 ARGS:     $datafile
400 EXPECT:   6
401
402 #######  Funky -p 7
403 }print$.;{
404 SWITCHES: -wln
405 ARGS:     $datafile
406 EXPECT:   6
407
408 #######  Abusing -M
409 1
410 SWITCHES
411 -Mstrict='}); print "Just another Perl Hacker"; ({'
412 -l
413 SKIP: No longer works in 5.8.2 and beyond.
414 SKIP_OS: MSWin32
415
416 #######  rand
417 srand 123456;$-=rand$_--=>@[[$-,$_]=@[[$_,$-]for(reverse+1..(@[=split
418 //=>"IGrACVGQ\x02GJCWVhP\x02PL\x02jNMP"));print+(map{$_^q^"^}@[),"\n"
419 SKIP: Solaris specific.
420
421 #######  print and __PACKAGE__
422 package 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 % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %;
432 BEGIN {% % = ($ _ = " " => print "Just another Perl Hacker\n")}
433
434 #######  Tie 1
435 sub J::FETCH{Just   }$_.='print+"@{[map';sub J::TIESCALAR{bless\my$J,J}
436 sub A::FETCH{another}$_.='{tie my($x),$';sub A::TIESCALAR{bless\my$A,A}
437 sub P::FETCH{Perl   }$_.='_;$x}qw/J A P';sub P::TIESCALAR{bless\my$P,P}
438 sub H::FETCH{Hacker }$_.=' H/]}\n"';eval;sub H::TIESCALAR{bless\my$H,H}
439
440 #######  Tie 2
441 package Z;use overload'""'=>sub{$b++?Hacker:another};
442 sub TIESCALAR{bless\my$y=>Z}sub FETCH{$a++?Perl:Just}
443 $,=$";my$x=tie+my$y=>Z;print$y,$x,$y,$x,"\n";#Abigail
444 EXPECT: $JaPH_s
445
446 #######  Tie 3
447 sub A::TIESCALAR{bless\my$x=>A};package B;@q[0..3]=qw/Hacker Perl
448 another 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
452 sub A::TIESCALAR{bless\my$x=>'A'};package B;@q=qw/Hacker Perl
453 another 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
457 tie $" => A; $, = " "; $\ = "\n"; @a = ("") x 2; print map {"@a"} 1 .. 4;
458 sub A::TIESCALAR {bless \my $A => A} #  Yet Another silly JAPH by Abigail
459 sub A::FETCH     {@q = qw /Just Another Perl Hacker/ unless @q; shift @q}
460 SKIP: Pending a bug fix.
461
462 #######  Prototype fun 1
463 sub camel (^#87=i@J&&&#]u'^^s]#'#={123{#}7890t[0.9]9@+*`"'***}A&&&}n2o}00}t324i;
464 h[{e **###{r{+P={**{e^^^#'#i@{r'^=^{l+{#}H***i[0.9]&@a5`"':&^;&^,*&^$43##@@####;
465 c}^^^&&&k}&&&}#=e*****[]}'r####'`=437*{#};::'1[0.9]2@43`"'*#==[[.{{],,,1278@#@);
466 print+((($llama=prototype'camel')=~y|+{#}$=^*&[0-9]i@:;`"',.| |d)&&$llama."\n");
467 SKIP: Abuses a fixed bug.
468
469 #######  Prototype fun 2
470 print prototype sub "Just another Perl Hacker" {};
471 SKIP: Abuses a fixed bug.
472
473 #######  Prototype fun 3
474 sub _ "Just another Perl Hacker"; print prototype \&_
475 SKIP: 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); &{%{%_}};
482 SKIP: Hashes are now randomized.
483 EXPECT: $JaPH_s
484
485 #######  Split 2
486 $" = "/"; split // => eval join "+" => 1 .. 7;
487 *{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}};
488 %_ = (Just => another => Perl => Hacker); &{%_};
489 SKIP: Hashes are now randomized.
490 EXPECT: $JaPH_s
491
492 #######  Split 3
493 $" = "/"; split $, => eval join "+" => 1 .. 7;
494 *{"@_"} = sub  {foreach (sort keys %_) {print "$_ $_{$_} "}};
495 %{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}};
496 SKIP: Hashes are now randomized.
497 EXPECT: $JaPH_s
498
499 #######  Here documents 1
500 $_ = "\x3C\x3C\x45\x4F\x54"; s/<<EOT/<<EOT/e; print;
501 Just another Perl Hacker
502 EOT
503
504 #######  Here documents 2
505 $_ = "\x3C\x3C\x45\x4F\x54";
506 print if s/<<EOT/<<EOT/e;
507 Just another Perl Hacker
508 EOT
509
510 #######  Here documents 3
511 $_ = "\x3C\x3C\x45\x4F\x54" and s/<<EOT/<<EOT/e and print;
512 Just another Perl Hacker
513 EOT
514
515 #######  Here documents 4
516 $_ = "\x3C\x3C\x45\x4F\x54\n" and s/<<EOT/<<EOT/ee and print;
517 "Just another Perl Hacker"
518 EOT
519
520 #######  Self modifying code 1
521 $_ = "goto F.print chop;\n=rekcaH lreP rehtona tsuJ";F1:eval
522 SWITCHES: -w
523
524 #######  Overloaded constants 1
525 BEGIN {$^H {q} = sub {pop and pop and print pop}; $^H = 2**4.2**12}
526 "Just "; "another "; "Perl "; "Hacker";
527 SKIP_OS: qnx
528
529 #######  Overloaded constants 2
530 BEGIN {$^H {q} = sub {$_ [1] =~ y/S-ZA-IK-O/q-tc-fe-m/d; $_ [1]}; $^H = 0x28100}
531 print "Just another PYTHON hacker\n";
532 EXPECT: $JaPh
533
534 #######  Overloaded constants 3
535 BEGIN {$^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}
538 print 1, 2, 3, 4;
539
540 #######  Overloaded constants 4
541 BEGIN {$^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}
544 print 1, 2, 3, 4, "\n";
545
546 #######  Overloaded constants 5
547 BEGIN {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}
550 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;
551
552 #######  v-strings 1
553 print v74.117.115.116.32;
554 print v97.110.111.116.104.101.114.32;
555 print v80.101.114.108.32;
556 print v72.97.99.107.101.114.10;
557
558 #######  v-strings 2
559 print 74.117.115.116.32;
560 print 97.110.111.116.104.101.114.32;
561 print 80.101.114.108.32;
562 print 72.97.99.107.101.114.10;
563
564 #######  v-strings 3
565 print 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
569 print 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
573 print 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
577 print 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.
581 map{${+chr}=chr}map{$_=>$_^ord$"}$=+$]..3*$=/2;        
582 print "$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?
590 print%;                              # No right operand for %?
591
592 #######  @; fun
593 @;=split//=>"Joel, Preach sartre knuth\n";$;=chr 65;%;=map{$;++=>$_}
594 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
595 ;print@;[@;{A..Z}];
596 EXPECT: $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;
604 sub japh {print "@_" and return if pop; split /\d/ and &japh}
605 SKIP: As of 5.12.0, split() in void context no longer populates @_.
606
607 ####### magic goto.
608 sub _ {$_ = 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       & _
612 SKIP: 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 ####### $!
633 s[$,][join$,,(split$,,($!=85))[(q[0006143730380126152532042307].
634 q[41342211132019313505])=~m[..]g]]e and y[yIbp][HJkP] and print;
635 SKIP: Platform dependent.
636
637 ####### die 1
638 eval {die ["Just another Perl Hacker"]}; print ${$@}[$#{@${@}}]
639
640 ####### die 2
641 eval {die ["Just another Perl Hacker\n"]}; print ${$@}[$#{@${@}}]
642
643 ####### die 3
644 eval {die ["Just another Perl Hacker"]}; print ${${@}}[$#{@{${@}}}]
645
646 ####### die 4
647 eval {die ["Just another Perl Hacker\n"]}; print ${${@}}[$#{@{${@}}}]
648
649 ####### die 5
650 eval {die [[qq [Just another Perl Hacker]]]};; print
651 ${${${@}}[$#{@{${@}}}]}[$#{${@{${@}}}[$#{@{${@}}}]}]
652 SKIP: 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
660 BEGIN {print "Just "   }
661 CHECK {print "another "}
662 INIT  {print "Perl "   }
663 END   {print "Hacker\n"}
664
665 ####### Special blocks 2
666 END   {print "Hacker\n"}
667 INIT  {print "Perl "   }
668 CHECK {print "another "}
669 BEGIN {print "Just "   }
670
671 ####### Recursive regex.
672    my $qr =  qr/^.+?(;).+?\1|;Just another Perl Hacker;|;.+$/;
673       $qr =~  s/$qr//g;
674 print $qr, "\n";
675
676 ####### use lib 'coderef'
677 use   lib sub {($\) = split /\./ => pop; print $"};
678 eval "use Just" || eval "use another" || eval "use Perl" || eval "use Hacker";
679 EXPECT
680  Just another Perl Hacker