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