projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Fix email address.
[p5sagit/p5-mst-13.2.git] / t / japh / abigail.t
CommitLineData
6990bd83 1#!./perl -w
2
3#
4# Tests derived from Japhs.
5#
5a6f1faa 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 16# is unfortunately not a trivial task.
17#
18# WARNING: these tests are obfuscated. Do not get frustrated.
cb5780fe 19# Ask Abigail <abigail@foad.org>, or use the Deparse or Concise
cfb19460 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 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;
6990bd83 43 my $n = @_ ? shift : 1;
44 for (1..$n) {
51bdca1b 45 my $test = curr_test;
6990bd83 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') {
51bdca1b 102 skip "Your platform quotes differently.", 3;
6990bd83 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') {
51bdca1b 130 skip "Your platform quotes differently.", 1;
6990bd83 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}
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};
51bdca1b 192 skip $program -> {SKIP}, 1;
6990bd83 193 next;
194 }
195
760807ca 196 chomp @{$program -> {SKIP_OS}};
51bdca1b 197 if (@{$program -> {SKIP_OS}}) {
51bdca1b 198 if (grep {$^O eq $_} @{$program -> {SKIP_OS}}) {
199 skip "Your OS uses different quoting.", 1;
200 next;
201 }
6990bd83 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}
224
225 my @programs = (<< ' --', << ' --');
226#!./perl -- # No trailing newline after the last line!
227BEGIN{$|=$SIG{__WARN__}=sub{$_=$_[0];y-_- -;print/(.)"$/;seek _,-open(_
228,"+<$0"),2;truncate _,tell _;close _;exec$0}}//rekcaH_lreP_rehtona_tsuJ
229 --
230#!./perl -- # Remove trailing newline!
231BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/;
232truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ
233 --
234 chomp @programs;
235
51bdca1b 236 if ($^O eq 'VMS') {
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 "VMS", 2 * @programs;
241 last
242 }
243
244 use Config;
245 unless (defined $Config {useperlio}) {
246 skip "Uuseperlio", 2 * @programs;
247 last
248 }
249
6990bd83 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";
258 $command .= ' 2>&1' unless $^O eq 'MacOS';
760807ca 259 if ( $^O eq 'qnx' ) {
260 skip "#!./perl not supported in QNX4";
261 skip "#!./perl not supported in QNX4";
262 } else {
263 my $output = `$command`;
6990bd83 264
760807ca 265 is ($output, $JaPH, "Self correcting code $i");
6990bd83 266
760807ca 267 $output = `$command`;
268 is ($output, "", "Self corrected code $i");
269 }
270 $i ++;
6990bd83 271 }
272}
273
274__END__
275####### Funky loop 1.
276$_ = q ;4a75737420616e6f74686572205065726c204861636b65720as;;
277 for (s;s;s;s;s;s;s;s;s;s;s;s)
278 {s;(..)s?;qq qprint chr 0x$1 and \161 ssq;excess;}
279
280####### Funky loop 2.
281$_ = q *4a75737420616e6f74686572205065726c204861636b65720a*;
282for ($*=******;$**=******;$**=******) {$**=*******s*..*qq}
283print chr 0x$& and q
284qq}*excess********}
760807ca 285SKIP_OS: qnx
6990bd83 286
287####### Funky loop 3.
288$_ = q *4a75737420616e6f74686572205065726c204861636b65720a*;
289for ($*=******;$**=******;$**=******) {$**=*******s*..*qq}
290print chr 0x$& and q
291qq}*excess********}
760807ca 292SKIP_OS: qnx
6990bd83 293
294####### Funky loop 4.
295$_ = q ?4a75737420616e6f74686572205065726c204861636b65720as?;??;
296for (??;(??)x??;??)
297 {??;s;(..)s?;qq ?print chr 0x$1 and \161 ss?;excess;??}
298SKIP: Abuses a fixed bug.
299
300####### Funky loop 5.
301for (s??4a75737420616e6f74686572205065726c204861636b65720as?;??;??)
302 {s?(..)s\??qq \?print chr 0x$1 and q ss\??excess}
303SKIP: Abuses a fixed bug.
304
305####### Funky loop 6.
306$a = q 94a75737420616e6f74686572205065726c204861636b65720a9 and
307${qq$\x5F$} = q 97265646f9 and s g..g;
308qq e\x63\x68\x72\x20\x30\x78$&eggee;
309{eval if $a =~ s e..eqq qprint chr 0x$& and \x71\x20\x71\x71qeexcess}
310
311####### Roman Dates.
312@r=reverse(M=>(0)x99=>CM=>(0)x399=>D=>(0)x99=>CD=>(
3130)x299=>C=>(0)x9=>XC=>(0)x39=>L=>(0)x9=>XL=>(0)x29=>X=>IX=>0=>0=>0=>V=>IV=>0=>0
314=>I=>$==-2449231+gm_julian_day+time);do{until($=<$#r){$_.=$r[$#r];$=-=$#r}for(;
315!$r[--$#r];){}}while$=;$,="\x20";print+$_=>September=>MCMXCIII=>=>=>=>=>=>=>=>
316SWITCHES
317-MTimes::JulianDay
318-l
319SKIP: Times::JulianDay not part of the main distribution.
320
321####### Autoload 1.
322sub _'_{$_'_=~s/$a/$_/}map{$$_=$Z++}Y,a..z,A..X;*{($_::_=sprintf+q=%X==>"$A$Y".
323"$b$r$T$u")=~s~0~O~g;map+_::_,U=>T=>L=>$Z;$_::_}=*_;sub _{print+/.*::(.*)/s};;;
324*{chr($b*$e)}=*_'_;*__=*{chr(1<<$e)}; # Perl 5.6.0 broke this...
325_::_(r(e(k(c(a(H(__(l(r(e(P(__(r(e(h(t(o(n(a(__(t(us(J())))))))))))))))))))))))
326EXPECT: Just__another__Perl__Hacker
327
328####### Autoload 2.
329$"=$,;*{;qq{@{[(A..Z)[qq[0020191411140003]=~m[..]g]]}}}=*_=sub{print/::(.*)/};
330$\=$/;q<Just another Perl Hacker>->();
331
332####### Autoload 3.
333$"=$,;*{;qq{@{[(A..Z)[qq[0020191411140003]=~m[..]g]]}}}=*_;
334sub _ {push @_ => /::(.*)/s and goto &{ shift}}
335sub shift {print shift; @_ and goto &{+shift}}
336Hack ("Just", "Perl ", " ano", "er\n", "ther "); # YYYYMMDD
337
338####### Autoload 4.
339$, = " "; sub AUTOLOAD {($AUTOLOAD =~ /::(.*)/) [0];}
340print+Just (), another (), Perl (), Hacker ();
341
342####### Look ma! No letters!
343$@="\145\143\150\157\040\042\112\165\163\164\040\141\156\157\164".
344 "\150\145\162\040\120\145\162\154\040\110\141\143\153\145\162".
345 "\042\040\076\040\057\144\145\166\057\164\164\171";`$@`
346SKIP: Unix specific
347
348####### sprintf fun 1.
349sub f{sprintf$_[0],$_[1],$_[2]}print f('%c%s',74,f('%c%s',117,f('%c%s',115,f(
350'%c%s',116,f('%c%s',32,f('%c%s',97,f('%c%s',0x6e,f('%c%s',111,f('%c%s',116,f(
351'%c%s',104,f('%c%s',0x65,f('%c%s',114,f('%c%s',32,f('%c%s',80,f('%c%s',101,f(
352'%c%s',114,f('%c%s',0x6c,f('%c%s',32,f('%c%s',0x48,f('%c%s',97,f('%c%s',99,f(
353'%c%s',107,f('%c%s',101,f('%c%s',114,f('%c%s',10,)))))))))))))))))))))))))
354
355####### sprintf fun 2.
356sub f{sprintf'%c%s',$_[0],$_[1]}print f(74,f(117,f(115,f(116,f(32,f(97,
357f(110,f(111,f(116,f(104,f(0x65,f(114,f(32,f(80,f(101,f(114,f(0x6c,f(32,
358f(0x48,f(97,f(99,f(107,f(101,f(114,f(10,q ff)))))))))))))))))))))))))
359
360####### Hanoi.
361%0=map{local$_=$_;reverse+chop,$_}ABC,ACB,BAC,BCA,CAB,CBA;$_=3 .AC;1while+
362s/(\d+)((.)(.))/($0=$1-1)?"$0$3$0{$2}1$2$0$0{$2}$4":"$3 => $4\n"/xeg;print
363EXPECT
364A => C
365A => B
366C => B
367A => C
368B => A
369B => C
370A => C
371
372####### Funky -p 1
373}{$_=$.
374SWITCHES: -wlp
375ARGS: $datafile
376EXPECT: 6
377
378####### Funky -p 2
379}$_=$.;{
380SWITCHES: -wlp
381ARGS: $datafile
382EXPECT: 6
383
384####### Funky -p 3
385}{$_=$.}{
386SWITCHES: -wlp
387ARGS: $datafile
388EXPECT: 6
389
390####### Funky -p 4
391}{*_=*.}{
392SWITCHES: -wlp
393ARGS: $datafile
394EXPECT: 6
395
396####### Funky -p 5
397}for($.){print
398SWITCHES: -wln
399ARGS: $datafile
400EXPECT: 6
401
402####### Funky -p 6
403}{print$.
404SWITCHES: -wln
405ARGS: $datafile
406EXPECT: 6
407
408####### Funky -p 7
409}print$.;{
410SWITCHES: -wln
411ARGS: $datafile
412EXPECT: 6
413
414####### Abusing -M
4151
416SWITCHES
417-Mstrict='}); print "Just another Perl Hacker"; ({'
418-l
419SKIP_OS: VMS
420MSWin32
421NetWare
422
423####### rand
424srand 123456;$-=rand$_--=>@[[$-,$_]=@[[$_,$-]for(reverse+1..(@[=split
425//=>"IGrACVGQ\x02GJCWVhP\x02PL\x02jNMP"));print+(map{$_^q^"^}@[),"\n"
426SKIP: Solaris specific.
427
428####### print and __PACKAGE__
429package Just_another_Perl_Hacker; sub print {($_=$_[0])=~ s/_/ /g;
430 print } sub __PACKAGE__ { &
431 print ( __PACKAGE__)} &
432 __PACKAGE__
433 ( )
434
435####### Decorations.
436* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
437/ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
438% % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %;
439BEGIN {% % = ($ _ = " " => print "Just another Perl Hacker\n")}
440
441####### Tie 1
442sub J::FETCH{Just }$_.='print+"@{[map';sub J::TIESCALAR{bless\my$J,J}
443sub A::FETCH{another}$_.='{tie my($x),$';sub A::TIESCALAR{bless\my$A,A}
444sub P::FETCH{Perl }$_.='_;$x}qw/J A P';sub P::TIESCALAR{bless\my$P,P}
445sub H::FETCH{Hacker }$_.=' H/]}\n"';eval;sub H::TIESCALAR{bless\my$H,H}
446
447####### Tie 2
448package Z;use overload'""'=>sub{$b++?Hacker:another};
449sub TIESCALAR{bless\my$y=>Z}sub FETCH{$a++?Perl:Just}
450$,=$";my$x=tie+my$y=>Z;print$y,$x,$y,$x,"\n";#Abigail
451EXPECT: $JaPH_s
452
453####### Tie 3
454sub A::TIESCALAR{bless\my$x=>A};package B;@q[0..3]=qw/Hacker Perl
455another Just/;use overload'""'=>sub{pop @q};sub A::FETCH{bless\my
456$y=>B}; tie my $shoe => qq 'A';print "$shoe $shoe $shoe $shoe\n";
457
458####### Tie 4
459sub A::TIESCALAR{bless\my$x=>'A'};package B;@q=qw/Hacker Perl
460another Just/;use overload'""',sub{pop @q};sub A::FETCH{bless
461\my $y=>B};tie my$shoe=>'A';print"$shoe $shoe $shoe $shoe\n";
462
463####### Tie 5
464tie $" => A; $, = " "; $\ = "\n"; @a = ("") x 2; print map {"@a"} 1 .. 4;
465sub A::TIESCALAR {bless \my $A => A} # Yet Another silly JAPH by Abigail
466sub A::FETCH {@q = qw /Just Another Perl Hacker/ unless @q; shift @q}
467SKIP: Pending a bug fix.
468
469####### Prototype fun 1
470sub camel (^#87=i@J&&&#]u'^^s]#'#={123{#}7890t[0.9]9@+*`"'***}A&&&}n2o}00}t324i;
471h[{e **###{r{+P={**{e^^^#'#i@{r'^=^{l+{#}H***i[0.9]&@a5`"':&^;&^,*&^$43##@@####;
472c}^^^&&&k}&&&}#=e*****[]}'r####'`=437*{#};::'1[0.9]2@43`"'*#==[[.{{],,,1278@#@);
473print+((($llama=prototype'camel')=~y|+{#}$=^*&[0-9]i@:;`"',.| |d)&&$llama."\n");
474SKIP: Abuses a fixed bug.
475
476####### Prototype fun 2
477print prototype sub "Just another Perl Hacker" {};
478
479####### Prototype fun 3
480sub _ "Just another Perl Hacker"; print prototype \&_
481
482####### Split 1
483 split // => '"';
484${"@_"} = "/"; split // => eval join "+" => 1 .. 7;
485*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}};
486%{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}};
487EXPECT: $JaPH_s
488
489####### Split 2
490$" = "/"; split // => eval join "+" => 1 .. 7;
491*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}};
492%_ = (Just => another => Perl => Hacker); &{%_};
493EXPECT: $JaPH_s
494
495####### Split 3
496$" = "/"; split $, => eval join "+" => 1 .. 7;
497*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}};
498%{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}};
499EXPECT: $JaPH_s
500
501####### Here documents 1
502$_ = "\x3C\x3C\x45\x4F\x54"; s/<<EOT/<<EOT/e; print;
503Just another Perl Hacker
504EOT
505
506####### Here documents 2
507$_ = "\x3C\x3C\x45\x4F\x54";
508print if s/<<EOT/<<EOT/e;
509Just another Perl Hacker
510EOT
511
512####### Here documents 3
513$_ = "\x3C\x3C\x45\x4F\x54" and s/<<EOT/<<EOT/e and print;
514Just another Perl Hacker
515EOT
516
517####### Here documents 4
518$_ = "\x3C\x3C\x45\x4F\x54\n" and s/<<EOT/<<EOT/ee and print;
519"Just another Perl Hacker"
520EOT
521
522####### Self modifying code 1
523$_ = "goto F.print chop;\n=rekcaH lreP rehtona tsuJ";F1:eval
524SWITCHES: -w
525
526####### Overloaded constants 1
527BEGIN {$^H {q} = sub {pop and pop and print pop}; $^H = 2**4.2**12}
528"Just "; "another "; "Perl "; "Hacker";
760807ca 529SKIP_OS: qnx
6990bd83 530
531####### Overloaded constants 2
532BEGIN {$^H {q} = sub {$_ [1] =~ y/S-ZA-IK-O/q-tc-fe-m/d; $_ [1]}; $^H = 0x28100}
533print "Just another PYTHON hacker\n";
534EXPECT: $JaPh
535
536####### Overloaded constants 3
537BEGIN {$^H {join "" => ("a" .. "z") [8, 13, 19, 4, 6, 4, 17]} = sub
538 {["", "Just ", "another ", "Perl ", "Hacker\n"] -> [shift]};
539 $^H = hex join "" => reverse map {int ($_ / 2)} 0 .. 4}
540print 1, 2, 3, 4;
541
542####### Overloaded constants 4
543BEGIN {$^H {join "" => ("a" .. "z") [8, 13, 19, 4, 6, 4, 17]} = sub
544 {["", "Just ", "another ", "Perl ", "Hacker"] -> [shift]};
545 $^H = hex join "" => reverse map {int ($_ / 2)} 0 .. 4}
546print 1, 2, 3, 4, "\n";
547
548####### Overloaded constants 5
549BEGIN {my $x = "Knuth heals rare project\n";
550 $^H {integer} = sub {my $y = shift; $_ = substr $x => $y & 0x1F, 1;
551 $y > 32 ? uc : lc}; $^H = hex join "" => 2, 1, 1, 0, 0}
552print 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;
553
554####### v-strings 1
555print v74.117.115.116.32;
556print v97.110.111.116.104.101.114.32;
557print v80.101.114.108.32;
558print v72.97.99.107.101.114.10;
559
560####### v-strings 2
561print 74.117.115.116.32;
562print 97.110.111.116.104.101.114.32;
563print 80.101.114.108.32;
564print 72.97.99.107.101.114.10;
565
566####### v-strings 3
567print v74.117.115.116.32, v97.110.111.116.104.101.114.32,
568 v80.101.114.108.32, v72.97.99.107.101.114.10;
569
570####### v-strings 4
571print 74.117.115.116.32, 97.110.111.116.104.101.114.32,
572 80.101.114.108.32, 72.97.99.107.101.114.10;
573
574####### v-strings 5
575print v74.117.115.116.32.97.110.111.116.104.101.114.
576 v32.80.101.114.108.32.72.97.99.107.101.114.10;
577
578####### v-strings 6
579print 74.117.115.116.32.97.110.111.116.104.101.114.
580 32.80.101.114.108.32.72.97.99.107.101.114.10;
581
582####### Symbolic references.
583map{${+chr}=chr}map{$_=>$_^ord$"}$=+$]..3*$=/2;
584print "$J$u$s$t $a$n$o$t$h$e$r $P$e$r$l $H$a$c$k$e$r\n";
585
586####### $; fun
587$; # A lone dollar?
588=$"; # Pod?
589$; # The return of the lone dollar?
590{Just=>another=>Perl=>Hacker=>} # Bare block?
591=$/; # More pod?
592print%; # No right operand for %?
593
594####### @; fun
595@;=split//=>"Joel, Preach sartre knuth\n";$;=chr 65;%;=map{$;++=>$_}
5960,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
597;print@;[@;{A..Z}];
598EXPECT: $JaPh_c
599
600####### %; fun
601$;=$";$;{Just=>another=>Perl=>Hacker=>}=$/;print%;
602
603####### &func;
604$_ = "\112\165\163\1648\141\156\157\164\150\145\1628\120\145"
605 . "\162\1548\110\141\143\153\145\162\0128\177" and &japh;
606sub japh {print "@_" and return if pop; split /\d/ and &japh}
607
608####### magic goto.
609sub _ {$_ = shift and y/b-yB-Y/a-yB-Y/ xor !@ _?
610 exit print :
611 print and push @_ => shift and goto &{(caller (0)) [3]}}
612 split // => "KsvQtbuf fbsodpmu\ni flsI " xor & _
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${${${@}}[$#{@{${@}}}]}[$#{${@{${@}}}[$#{@{${@}}}]}]
652
653####### Closure returning itself.
654$_ = "\nrekcaH lreP rehtona tsuJ"; my $chop; $chop = sub {print chop; $chop};
655$chop -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> ()
656-> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> ()
657
658####### Special blocks 1
659BEGIN {print "Just " }
660CHECK {print "another "}
661INIT {print "Perl " }
662END {print "Hacker\n"}
663
664####### Special blocks 2
665END {print "Hacker\n"}
666INIT {print "Perl " }
667CHECK {print "another "}
668BEGIN {print "Just " }
669
670####### Recursive regex.
671 my $qr = qr/^.+?(;).+?\1|;Just another Perl Hacker;|;.+$/;
672 $qr =~ s/$qr//g;
673print $qr, "\n";
674
675####### use lib 'coderef'
676use lib sub {($\) = split /\./ => pop; print $"};
677eval "use Just" || eval "use another" || eval "use Perl" || eval "use Hacker";
678EXPECT
679 Just another Perl Hacker
Unnamed repository; edit this file to name it for gitweb.