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