xref: /openbsd/gnu/usr.bin/perl/t/japh/abigail.t (revision 8932bfb7) 
1#!./perl -w
2
3#
4# Tests derived from Japhs.
5#
6# These test use obscure features of Perl, or surprising combinations
7# of features. The tests were added because in the past, they have
8# exposed several bugs in Perl.
9#
10# Some of these tests may actually (mis)use bugs or use undefined behaviour.
11# These tests are still useful - behavioural changes or bugfixes will be
12# noted, and a remark can be put in the documentation. (Don't forget to
13# disable the test!)
14#
15# Getting everything to run well on the myriad of platforms Perl runs on
16# is unfortunately not a trivial task.
17#
18# WARNING: these tests are obfuscated.  Do not get frustrated.
19# Ask Abigail <abigail@abigail.be>, or use the Deparse or Concise
20# modules (the former parses Perl to Perl, the latter shows the
21# op syntax tree) like this:
22# ./perl -Ilib -MO=Deparse foo.pl
23# ./perl -Ilib -MO=Concise foo.pl
24#
25
26BEGIN {
27    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#
41sub 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#
55sub notok {
56    my ($pass, $name, @mess) = @_;
57    _ok(!$pass, _where(), $name, @mess);
58}
59
60my $JaPH   = "Just another Perl Hacker";
61my $JaPh   = "Just another Perl hacker";
62my $JaPH_n = "Just another Perl Hacker\n";
63my $JaPh_n = "Just another Perl hacker\n";
64my $JaPH_s = "Just another Perl Hacker ";
65my $JaPh_s = "Just another Perl hacker ";
66my $JaPH_c = "Just another Perl Hacker,";
67my $JaPh_c = "Just another Perl hacker,";
68
69plan 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
227BEGIN{$|=$SIG{__WARN__}=sub{$_=$_[0];y-_- -;print/(.)"$/;seek _,-open(_
228,"+<$0"),2;truncate _,tell _;close _;exec$0}}//rekcaH_lreP_rehtona_tsuJ
229    --
230#!./perl
231BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/;
232truncate$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*;
281for ($*=******;$**=******;$**=******) {$**=*******s*..*qq}
282print chr 0x$& and q
283qq}*excess********}
284SKIP: $* was removed.
285
286#######  Funky loop 3.
287$_ = q *4a75737420616e6f74686572205065726c204861636b65720a*;
288for ($*=******;$**=******;$**=******) {$**=*******s*..*qq}
289print chr 0x$& and q
290qq}*excess********}
291SKIP: $* was removed.
292
293#######  Funky loop 4.
294$_ = q ?4a75737420616e6f74686572205065726c204861636b65720as?;??;
295for (??;(??)x??;??)
296    {??;s;(..)s?;qq ?print chr 0x$1 and \161 ss?;excess;??}
297SKIP: Abuses a fixed bug.
298
299#######  Funky loop 5.
300for (s??4a75737420616e6f74686572205065726c204861636b65720as?;??;??)
301    {s?(..)s\??qq \?print chr 0x$1 and q ss\??excess}
302SKIP: Abuses a fixed bug.
303
304#######  Funky loop 6.
305$a = q 94a75737420616e6f74686572205065726c204861636b65720a9 and
306${qq$\x5F$} = q 97265646f9 and s g..g;
307qq 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=>(
3120)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=>=>=>=>=>=>=>=>
315SWITCHES
316-MTimes::JulianDay
317-l
318SKIP: Times::JulianDay not part of the main distribution.
319
320#######  Autoload 1.
321sub _'_{$_'_=~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())))))))))))))))))))))))
325EXPECT: 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]]}}}=*_;
333sub   _   {push         @_ => /::(.*)/s and goto &{ shift}}
334sub shift {print shift; @_              and goto &{+shift}}
335Hack ("Just", "Perl ", " ano", "er\n", "ther "); # YYYYMMDD
336
337#######  Autoload 4.
338$, = " "; sub AUTOLOAD {($AUTOLOAD =~ /::(.*)/) [0];}
339print+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";`$@`
345SKIP: Unix specific
346
347#######  sprintf fun 1.
348sub 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.
355sub f{sprintf'%c%s',$_[0],$_[1]}print f(74,f(117,f(115,f(116,f(32,f(97,
356f(110,f(111,f(116,f(104,f(0x65,f(114,f(32,f(80,f(101,f(114,f(0x6c,f(32,
357f(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+
361s/(\d+)((.)(.))/($0=$1-1)?"$0$3$0{$2}1$2$0$0{$2}$4":"$3 => $4\n"/xeg;print
362EXPECT
363A => C
364A => B
365C => B
366A => C
367B => A
368B => C
369A => C
370
371#######  Funky -p 1
372}{$_=$.
373SWITCHES: -wlp
374ARGS:     $datafile
375EXPECT:   6
376
377#######  Funky -p 2
378}$_=$.;{
379SWITCHES: -wlp
380ARGS:     $datafile
381EXPECT:   6
382
383#######  Funky -p 3
384}{$_=$.}{
385SWITCHES: -wlp
386ARGS:     $datafile
387EXPECT:   6
388
389#######  Funky -p 4
390}{*_=*.}{
391SWITCHES: -wlp
392ARGS:     $datafile
393EXPECT:   6
394
395#######  Funky -p 5
396}for($.){print
397SWITCHES: -wln
398ARGS:     $datafile
399EXPECT:   6
400
401#######  Funky -p 6
402}{print$.
403SWITCHES: -wln
404ARGS:     $datafile
405EXPECT:   6
406
407#######  Funky -p 7
408}print$.;{
409SWITCHES: -wln
410ARGS:     $datafile
411EXPECT:   6
412
413#######  Abusing -M
4141
415SWITCHES
416-Mstrict='}); print "Just another Perl Hacker"; ({'
417-l
418SKIP: No longer works in 5.8.2 and beyond.
419SKIP_OS: MSWin32
420SKIP_OS: NetWare
421
422#######  rand
423srand 123456;$-=rand$_--=>@[[$-,$_]=@[[$_,$-]for(reverse+1..(@[=split
424//=>"IGrACVGQ\x02GJCWVhP\x02PL\x02jNMP"));print+(map{$_^q^"^}@[),"\n"
425SKIP: Solaris specific.
426
427#######  print and __PACKAGE__
428package 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% % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %;
438BEGIN {% % = ($ _ = " " => print "Just another Perl Hacker\n")}
439
440#######  Tie 1
441sub J::FETCH{Just   }$_.='print+"@{[map';sub J::TIESCALAR{bless\my$J,J}
442sub A::FETCH{another}$_.='{tie my($x),$';sub A::TIESCALAR{bless\my$A,A}
443sub P::FETCH{Perl   }$_.='_;$x}qw/J A P';sub P::TIESCALAR{bless\my$P,P}
444sub H::FETCH{Hacker }$_.=' H/]}\n"';eval;sub H::TIESCALAR{bless\my$H,H}
445
446#######  Tie 2
447package Z;use overload'""'=>sub{$b++?Hacker:another};
448sub TIESCALAR{bless\my$y=>Z}sub FETCH{$a++?Perl:Just}
449$,=$";my$x=tie+my$y=>Z;print$y,$x,$y,$x,"\n";#Abigail
450EXPECT: $JaPH_s
451
452#######  Tie 3
453sub A::TIESCALAR{bless\my$x=>A};package B;@q[0..3]=qw/Hacker Perl
454another 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
458sub A::TIESCALAR{bless\my$x=>'A'};package B;@q=qw/Hacker Perl
459another 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
463tie $" => A; $, = " "; $\ = "\n"; @a = ("") x 2; print map {"@a"} 1 .. 4;
464sub A::TIESCALAR {bless \my $A => A} #  Yet Another silly JAPH by Abigail
465sub A::FETCH     {@q = qw /Just Another Perl Hacker/ unless @q; shift @q}
466SKIP: Pending a bug fix.
467
468#######  Prototype fun 1
469sub camel (^#87=i@J&&&#]u'^^s]#'#={123{#}7890t[0.9]9@+*`"'***}A&&&}n2o}00}t324i;
470h[{e **###{r{+P={**{e^^^#'#i@{r'^=^{l+{#}H***i[0.9]&@a5`"':&^;&^,*&^$43##@@####;
471c}^^^&&&k}&&&}#=e*****[]}'r####'`=437*{#};::'1[0.9]2@43`"'*#==[[.{{],,,1278@#@);
472print+((($llama=prototype'camel')=~y|+{#}$=^*&[0-9]i@:;`"',.| |d)&&$llama."\n");
473SKIP: Abuses a fixed bug.
474
475#######  Prototype fun 2
476print prototype sub "Just another Perl Hacker" {};
477SKIP: Abuses a fixed bug.
478
479#######  Prototype fun 3
480sub _ "Just another Perl Hacker"; print prototype \&_
481SKIP: 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); &{%{%_}};
488SKIP: Hashes are now randomized.
489EXPECT: $JaPH_s
490
491#######  Split 2
492$" = "/"; split // => eval join "+" => 1 .. 7;
493*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}};
494%_ = (Just => another => Perl => Hacker); &{%_};
495SKIP: Hashes are now randomized.
496EXPECT: $JaPH_s
497
498#######  Split 3
499$" = "/"; split $, => eval join "+" => 1 .. 7;
500*{"@_"} = sub  {foreach (sort keys %_) {print "$_ $_{$_} "}};
501%{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}};
502SKIP: Hashes are now randomized.
503EXPECT: $JaPH_s
504
505#######  Here documents 1
506$_ = "\x3C\x3C\x45\x4F\x54"; s/<<EOT/<<EOT/e; print;
507Just another Perl Hacker
508EOT
509
510#######  Here documents 2
511$_ = "\x3C\x3C\x45\x4F\x54";
512print if s/<<EOT/<<EOT/e;
513Just another Perl Hacker
514EOT
515
516#######  Here documents 3
517$_ = "\x3C\x3C\x45\x4F\x54" and s/<<EOT/<<EOT/e and print;
518Just another Perl Hacker
519EOT
520
521#######  Here documents 4
522$_ = "\x3C\x3C\x45\x4F\x54\n" and s/<<EOT/<<EOT/ee and print;
523"Just another Perl Hacker"
524EOT
525
526#######  Self modifying code 1
527$_ = "goto F.print chop;\n=rekcaH lreP rehtona tsuJ";F1:eval
528SWITCHES: -w
529
530#######  Overloaded constants 1
531BEGIN {$^H {q} = sub {pop and pop and print pop}; $^H = 2**4.2**12}
532"Just "; "another "; "Perl "; "Hacker";
533SKIP_OS: qnx
534
535#######  Overloaded constants 2
536BEGIN {$^H {q} = sub {$_ [1] =~ y/S-ZA-IK-O/q-tc-fe-m/d; $_ [1]}; $^H = 0x28100}
537print "Just another PYTHON hacker\n";
538EXPECT: $JaPh
539
540#######  Overloaded constants 3
541BEGIN {$^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}
544print 1, 2, 3, 4;
545
546#######  Overloaded constants 4
547BEGIN {$^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}
550print 1, 2, 3, 4, "\n";
551
552#######  Overloaded constants 5
553BEGIN {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}
556print 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
559print v74.117.115.116.32;
560print v97.110.111.116.104.101.114.32;
561print v80.101.114.108.32;
562print v72.97.99.107.101.114.10;
563
564#######  v-strings 2
565print 74.117.115.116.32;
566print 97.110.111.116.104.101.114.32;
567print 80.101.114.108.32;
568print 72.97.99.107.101.114.10;
569
570#######  v-strings 3
571print 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
575print 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
579print 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
583print 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.
587map{${+chr}=chr}map{$_=>$_^ord$"}$=+$]..3*$=/2;
588print "$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?
596print%;                              # No right operand for %?
597
598#######  @; fun
599@;=split//=>"Joel, Preach sartre knuth\n";$;=chr 65;%;=map{$;++=>$_}
6000,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}];
602EXPECT: $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;
610sub japh {print "@_" and return if pop; split /\d/ and &japh}
611SKIP: As of 5.12.0, split() in void context no longer populates @_.
612
613####### magic goto.
614sub _ {$_ = 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       & _
618SKIP: 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####### $!
639s[$,][join$,,(split$,,($!=85))[(q[0006143730380126152532042307].
640q[41342211132019313505])=~m[..]g]]e and y[yIbp][HJkP] and print;
641SKIP: Platform dependent.
642
643####### die 1
644eval {die ["Just another Perl Hacker"]}; print ${$@}[$#{@${@}}]
645
646####### die 2
647eval {die ["Just another Perl Hacker\n"]}; print ${$@}[$#{@${@}}]
648
649####### die 3
650eval {die ["Just another Perl Hacker"]}; print ${${@}}[$#{@{${@}}}]
651
652####### die 4
653eval {die ["Just another Perl Hacker\n"]}; print ${${@}}[$#{@{${@}}}]
654
655####### die 5
656eval {die [[qq [Just another Perl Hacker]]]};; print
657${${${@}}[$#{@{${@}}}]}[$#{${@{${@}}}[$#{@{${@}}}]}]
658SKIP: 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
666BEGIN {print "Just "   }
667CHECK {print "another "}
668INIT  {print "Perl "   }
669END   {print "Hacker\n"}
670
671####### Special blocks 2
672END   {print "Hacker\n"}
673INIT  {print "Perl "   }
674CHECK {print "another "}
675BEGIN {print "Just "   }
676
677####### Recursive regex.
678   my $qr =  qr/^.+?(;).+?\1|;Just another Perl Hacker;|;.+$/;
679      $qr =~  s/$qr//g;
680print $qr, "\n";
681
682####### use lib 'coderef'
683use   lib sub {($\) = split /\./ => pop; print $"};
684eval "use Just" || eval "use another" || eval "use Perl" || eval "use Hacker";
685EXPECT
686 Just another Perl Hacker
687