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