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