This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
prevent calling recursing into S_concat_pat() for an empty array
[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' ||
6990bd83 97 $^O eq 'VMS') {
51bdca1b 98 skip "Your platform quotes differently.", 3;
6990bd83
A		 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' ||
6990bd83 124 $^O eq 'VMS') {
51bdca1b 125 skip "Your platform quotes differently.", 1;
6990bd83
A		 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;
dc459aad 138 END {unlink_all $datafile if $datafile}
6990bd83
A		 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};
51bdca1b 187 skip $program -> {SKIP}, 1;
6990bd83
A		 188 next;
189 }
190
760807ca 191 chomp @{$program -> {SKIP_OS}};
51bdca1b 192 if (@{$program -> {SKIP_OS}}) {
51bdca1b
JH		 193 if (grep {$^O eq $_} @{$program -> {SKIP_OS}}) {
194 skip "Your OS uses different quoting.", 1;
195 next;
196 }
6990bd83
A		 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;
dc459aad 218 END {unlink_all $progfile if $progfile}
6990bd83
A		 219
220 my @programs = (<< ' --', << ' --');
4e508696 221#!./perl
6990bd83
A		 222BEGIN{$|=$SIG{__WARN__}=sub{$_=$_[0];y-_- -;print/(.)"$/;seek _,-open(_
223,"+<$0"),2;truncate _,tell _;close _;exec$0}}//rekcaH_lreP_rehtona_tsuJ
224 --
4e508696 225#!./perl
6990bd83
A		 226BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/;
227truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ
228 --
229 chomp @programs;
230
0d37d453 231 if ($^O eq 'VMS' or $^O eq 'MSWin32') {
51bdca1b
JH		 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.
0d37d453 235 skip $^O, 2 * @programs;
51bdca1b
JH		 236 last
237 }
238
239 use Config;
240 unless (defined $Config {useperlio}) {
241 skip "Uuseperlio", 2 * @programs;
242 last
243 }
244
6990bd83
A		 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";
7b903762 252 my $command = "./$progfile 2>&1";
760807ca
NA		 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`;
6990bd83 258
760807ca 259 is ($output, $JaPH, "Self correcting code $i");
6990bd83 260
760807ca
NA		 261 $output = `$command`;
262 is ($output, "", "Self corrected code $i");
263 }
264 $i ++;
6990bd83
A		 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*;
276for ($*=******;$**=******;$**=******) {$**=*******s*..*qq}
277print chr 0x$& and q
278qq}*excess********}
503d18c3 279SKIP: $* was removed.
6990bd83
A		 280
281####### Funky loop 3.
282$_ = q *4a75737420616e6f74686572205065726c204861636b65720a*;
283for ($*=******;$**=******;$**=******) {$**=*******s*..*qq}
284print chr 0x$& and q
285qq}*excess********}
503d18c3 286SKIP: $* was removed.
6990bd83
A		 287
288####### Funky loop 4.
289$_ = q ?4a75737420616e6f74686572205065726c204861636b65720as?;??;
290for (??;(??)x??;??)
291 {??;s;(..)s?;qq ?print chr 0x$1 and \161 ss?;excess;??}
292SKIP: Abuses a fixed bug.
293
294####### Funky loop 5.
295for (s??4a75737420616e6f74686572205065726c204861636b65720as?;??;??)
296 {s?(..)s\??qq \?print chr 0x$1 and q ss\??excess}
297SKIP: Abuses a fixed bug.
298
299####### Funky loop 6.
300$a = q 94a75737420616e6f74686572205065726c204861636b65720a9 and
301${qq$\x5F$} = q 97265646f9 and s g..g;
302qq 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=>(
3070)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=>=>=>=>=>=>=>=>
310SWITCHES
311-MTimes::JulianDay
312-l
313SKIP: Times::JulianDay not part of the main distribution.
314
315####### Autoload 1.
316sub _'_{$_'_=~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())))))))))))))))))))))))
320EXPECT: 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]]}}}=*_;
328sub _ {push @_ => /::(.*)/s and goto &{ shift}}
329sub shift {print shift; @_ and goto &{+shift}}
330Hack ("Just", "Perl ", " ano", "er\n", "ther "); # YYYYMMDD
331
332####### Autoload 4.
333$, = " "; sub AUTOLOAD {($AUTOLOAD =~ /::(.*)/) [0];}
334print+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";`$@`
340SKIP: Unix specific
341
342####### sprintf fun 1.
343sub 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.
350sub f{sprintf'%c%s',$_[0],$_[1]}print f(74,f(117,f(115,f(116,f(32,f(97,
351f(110,f(111,f(116,f(104,f(0x65,f(114,f(32,f(80,f(101,f(114,f(0x6c,f(32,
352f(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+
356s/(\d+)((.)(.))/($0=$1-1)?"$0$3$0{$2}1$2$0$0{$2}$4":"$3 => $4\n"/xeg;print
357EXPECT
358A => C
359A => B
360C => B
361A => C
362B => A
363B => C
364A => C
365
366####### Funky -p 1
367}{$_=$.
368SWITCHES: -wlp
369ARGS: $datafile
370EXPECT: 6
371
372####### Funky -p 2
373}$_=$.;{
374SWITCHES: -wlp
375ARGS: $datafile
376EXPECT: 6
377
378####### Funky -p 3
379}{$_=$.}{
380SWITCHES: -wlp
381ARGS: $datafile
382EXPECT: 6
383
384####### Funky -p 4
385}{*_=*.}{
386SWITCHES: -wlp
387ARGS: $datafile
388EXPECT: 6
389
390####### Funky -p 5
391}for($.){print
392SWITCHES: -wln
393ARGS: $datafile
394EXPECT: 6
395
396####### Funky -p 6
397}{print$.
398SWITCHES: -wln
399ARGS: $datafile
400EXPECT: 6
401
402####### Funky -p 7
403}print$.;{
404SWITCHES: -wln
405ARGS: $datafile
406EXPECT: 6
407
408####### Abusing -M
4091
410SWITCHES
411-Mstrict='}); print "Just another Perl Hacker"; ({'
412-l
55082927 413SKIP: No longer works in 5.8.2 and beyond.
3c5e673a 414SKIP_OS: MSWin32
6990bd83
A		 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" {};
21d7e22a 471SKIP: Abuses a fixed bug.
6990bd83
A		 472
473####### Prototype fun 3
474sub _ "Just another Perl Hacker"; print prototype \&_
0d37d453 475SKIP: Abuses a fixed bug.
6990bd83
A		 476
477####### Split 1
478 split // => '"';
479${"@_"} = "/"; split // => eval join "+" => 1 .. 7;
480*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}};
481%{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}};
21d7e22a 482SKIP: Hashes are now randomized.
6990bd83
A		 483EXPECT: $JaPH_s
484
485####### Split 2
486$" = "/"; split // => eval join "+" => 1 .. 7;
487*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}};
488%_ = (Just => another => Perl => Hacker); &{%_};
21d7e22a 489SKIP: Hashes are now randomized.
6990bd83
A		 490EXPECT: $JaPH_s
491
492####### Split 3
493$" = "/"; split $, => eval join "+" => 1 .. 7;
494*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}};
495%{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}};
21d7e22a 496SKIP: Hashes are now randomized.
6990bd83
A		 497EXPECT: $JaPH_s
498
499####### Here documents 1
500$_ = "\x3C\x3C\x45\x4F\x54"; s/<<EOT/<<EOT/e; print;
501Just another Perl Hacker
502EOT
503
504####### Here documents 2
505$_ = "\x3C\x3C\x45\x4F\x54";
506print if s/<<EOT/<<EOT/e;
507Just another Perl Hacker
508EOT
509
510####### Here documents 3
511$_ = "\x3C\x3C\x45\x4F\x54" and s/<<EOT/<<EOT/e and print;
512Just another Perl Hacker
513EOT
514
515####### Here documents 4
516$_ = "\x3C\x3C\x45\x4F\x54\n" and s/<<EOT/<<EOT/ee and print;
517"Just another Perl Hacker"
518EOT
519
520####### Self modifying code 1
521$_ = "goto F.print chop;\n=rekcaH lreP rehtona tsuJ";F1:eval
522SWITCHES: -w
523
524####### Overloaded constants 1
525BEGIN {$^H {q} = sub {pop and pop and print pop}; $^H = 2**4.2**12}
526"Just "; "another "; "Perl "; "Hacker";
760807ca 527SKIP_OS: qnx
6990bd83
A		 528
529####### Overloaded constants 2
530BEGIN {$^H {q} = sub {$_ [1] =~ y/S-ZA-IK-O/q-tc-fe-m/d; $_ [1]}; $^H = 0x28100}
531print "Just another PYTHON hacker\n";
532EXPECT: $JaPh
533
534####### Overloaded constants 3
535BEGIN {$^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}
538print 1, 2, 3, 4;
539
540####### Overloaded constants 4
541BEGIN {$^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}
544print 1, 2, 3, 4, "\n";
545
546####### Overloaded constants 5
547BEGIN {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}
550print 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
553print v74.117.115.116.32;
554print v97.110.111.116.104.101.114.32;
555print v80.101.114.108.32;
556print v72.97.99.107.101.114.10;
557
558####### v-strings 2
559print 74.117.115.116.32;
560print 97.110.111.116.104.101.114.32;
561print 80.101.114.108.32;
562print 72.97.99.107.101.114.10;
563
564####### v-strings 3
565print 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
569print 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
573print 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
577print 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.
581map{${+chr}=chr}map{$_=>$_^ord$"}$=+$]..3*$=/2;
582print "$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?
590print%; # No right operand for %?
591
592####### @; fun
593@;=split//=>"Joel, Preach sartre knuth\n";$;=chr 65;%;=map{$;++=>$_}
5940,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}];
596EXPECT: $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;
604sub japh {print "@_" and return if pop; split /\d/ and &japh}
540810e8 605SKIP: As of 5.12.0, split() in void context no longer populates @_.
6990bd83
A		 606
607####### magic goto.
608sub _ {$_ = 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 & _
540810e8 612SKIP: As of 5.12.0, split() in void context no longer populates @_.
6990bd83
A		 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####### $!
633s[$,][join$,,(split$,,($!=85))[(q[0006143730380126152532042307].
634q[41342211132019313505])=~m[..]g]]e and y[yIbp][HJkP] and print;
635SKIP: Platform dependent.
636
637####### die 1
638eval {die ["Just another Perl Hacker"]}; print ${$@}[$#{@${@}}]
639
640####### die 2
641eval {die ["Just another Perl Hacker\n"]}; print ${$@}[$#{@${@}}]
642
643####### die 3
644eval {die ["Just another Perl Hacker"]}; print ${${@}}[$#{@{${@}}}]
645
646####### die 4
647eval {die ["Just another Perl Hacker\n"]}; print ${${@}}[$#{@{${@}}}]
648
649####### die 5
650eval {die [[qq [Just another Perl Hacker]]]};; print
651${${${@}}[$#{@{${@}}}]}[$#{${@{${@}}}[$#{@{${@}}}]}]
4d5114b4 652SKIP: Abuses a fixed bug; what is in $#{...} must be an arrayref, not an array
6990bd83
A		 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
660BEGIN {print "Just " }
661CHECK {print "another "}
662INIT {print "Perl " }
663END {print "Hacker\n"}
664
665####### Special blocks 2
666END {print "Hacker\n"}
667INIT {print "Perl " }
668CHECK {print "another "}
669BEGIN {print "Just " }
670
671####### Recursive regex.
672 my $qr = qr/^.+?(;).+?\1|;Just another Perl Hacker;|;.+$/;
673 $qr =~ s/$qr//g;
674print $qr, "\n";
675
676####### use lib 'coderef'
677use lib sub {($\) = split /\./ => pop; print $"};
678eval "use Just" || eval "use another" || eval "use Perl" || eval "use Hacker";
679EXPECT
680 Just another Perl Hacker
Unnamed repository; edit this file 'description' to name the repository.