From: Abigail Date: Mon, 15 Apr 2002 17:41:17 +0000 (+0200) Subject: t/japh/abigail.t (was: FETCH for tied $" called an odd number of times.) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6990bd8313a66cf767ee8399392cba03106747f2;p=p5sagit%2Fp5-mst-13.2.git t/japh/abigail.t (was: FETCH for tied $" called an odd number of times.) Message-ID: <20020415154117.1559.qmail@foad.org> (With EBCDIC skippage added, and the skip reason skippage on the two ?? loops tweaked.) p4raw-id: //depot/perl@15937 --- diff --git a/MANIFEST b/MANIFEST index 9a94b69..ee11406 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2274,6 +2274,7 @@ t/io/print.t See if print commands work t/io/read.t See if read works t/io/tell.t See if file seeking works t/io/utf8.t See if file seeking works +t/japh/abigail.t Obscure tests t/lib/1_compile.t See if the various libraries and extensions compile t/lib/commonsense.t See if configuration meets basic needs t/lib/compmod.pl Helper for 1_compile.t diff --git a/t/TEST b/t/TEST index ec6e554..7be22f1 100755 --- a/t/TEST +++ b/t/TEST @@ -92,8 +92,9 @@ unless (@ARGV) { } else { warn "$0: cannot open $mani: $!\n"; } - _find_tests('pod'); - _find_tests('x2p'); + _find_tests('pod') unless $core; + _find_tests('x2p') unless $core; + _find_tests('japh') unless $core; } # Tests known to cause infinite loops for the perlcc tests. diff --git a/t/japh/abigail.t b/t/japh/abigail.t new file mode 100644 index 0000000..9b2dc96 --- /dev/null +++ b/t/japh/abigail.t @@ -0,0 +1,636 @@ +#!./perl -w + +# +# Tests derived from Japhs. +# + +BEGIN { + if (ord("A") == 193) { + print "1..0 # Skip: EBCDIC\n"; # For now, until someone has time. + exit(0); + } + chdir 't' if -d 't'; + @INC = '../lib'; + require "./test.pl"; + undef &skip; +} + +# +# ./test.pl does real evilness by jumping to a label. +# This function copies the skip from ./test, omitting the goto. +# +sub skip { + my $why = shift; + my $test = curr_test; + my $n = @_ ? shift : 1; + for (1..$n) { + print STDOUT "ok $test # skip: $why\n"; + next_test; + } +} + + +# +# ./test.pl doesn't give use 'notok', so we make it here. +# +sub notok { + my ($pass, $name, @mess) = @_; + _ok(!$pass, _where(), $name, @mess); +} + +my $JaPH = "Just another Perl Hacker"; +my $JaPh = "Just another Perl hacker"; +my $JaPH_n = "Just another Perl Hacker\n"; +my $JaPh_n = "Just another Perl hacker\n"; +my $JaPH_s = "Just another Perl Hacker "; +my $JaPh_s = "Just another Perl hacker "; +my $JaPH_c = "Just another Perl Hacker,"; +my $JaPh_c = "Just another Perl hacker,"; + +plan tests => 130; + +{ + my $out = sprintf "Just another Perl Hacker"; + is ($out, $JaPH); +} + + +{ + my @primes = (2, 3, 7, 13, 53, 101, 557, 1429); + my @composites = (4, 10, 25, 32, 75, 143, 1333, 1728); + + my %primeness = ((map {$_ => 1} @primes), + (map {$_ => 0} @composites)); + + while (my ($num, $is_prime) = each %primeness) { + my $comment = "$num is " . ($is_prime ? "prime." : "composite."); + + my $sub = $is_prime ? "ok" : "notok"; + + &$sub (( 1 x $num) !~ /^1?$|^(11+?)\1+$/, $comment); + &$sub (( 0 x $num) !~ m 0^\0?$|^(\0\0+?)\1+$0, $comment); + &$sub (("m" x $num) !~ m m^\m?$|^(\m\m+?)\1+$mm, $comment); + } +} + + +{ # Some platforms use different quoting techniques. + # I do not have access to those platforms to test + # things out. So, we'll skip things.... + if ($^O eq 'MSWin32' || + $^O eq 'NetWare' || + $^O eq 'VMS') { + skip 3, "Your platform quotes differently.\n"; + last; + } + + my $expected = $JaPH; + $expected =~ s/ /\n/g; + $expected .= "\n"; + is (runperl (switches => [qw /'-weprint< 0), + $expected, "Multiple -e switches"); + + is (runperl (switches => [q !'-wle$_=< 0), + $JaPH . " \n", "Multiple -e switches"); + + is (runperl (switches => [qw !-wl!], + progs => [qw !print qq-@{[ qw+ Just + another Perl Hacker +]}-!], + verbose => 0), + $JaPH_n, "Multiple -e switches"); +} + +{ + if ($^O eq 'MSWin32' || + $^O eq 'NetWare' || + $^O eq 'VMS') { + skip 1, "Your platform quotes differently.\n"; + last; + } + is (runperl (switches => [qw /-sweprint --/, + "-_='Just another Perl Hacker'"], + nolib => 1, + verbose => 0), + $JaPH, 'setting $_ via -s'); +} + +{ + my $datafile = "datatmp000"; + 1 while -f ++ $datafile; + END {unlink_all $datafile} + + open MY_DATA, "> $datafile" or die "Failed to open $datafile: $!"; + print MY_DATA << " --"; + One + Two + Three + Four + Five + Six + -- + close MY_DATA or die "Failed to close $datafile: $!\n"; + + my @progs; + my $key; + while () { + last if /^__END__$/; + + if (/^#{7}(?:\s+(.*))?/) { + push @progs => {COMMENT => $1 || '', + CODE => '', + SKIP_OS => [], + ARGS => [], + SWITCHES => [],}; + $key = 'CODE'; + next; + } + elsif (/^(COMMENT|CODE|ARGS|SWITCHES|EXPECT|SKIP|SKIP_OS) + (?::\s+(.*))?$/sx) { + $key = $1; + $progs [-1] {$key} = '' unless exists $progs [-1] {$key}; + next unless defined $2; + $_ = $2; + } + elsif (/^$/) { + next; + } + + if (ref ($progs [-1] {$key})) { + push @{$progs [-1] {$key}} => $_; + } + else { + $progs [-1] {$key} .= $_; + } + } + + foreach my $program (@progs) { + if (exists $program -> {SKIP}) { + chomp $program -> {SKIP}; + skip $program -> {SKIP}; + next; + } + + if (@{$program -> {SKIP_OS}} && + grep {$^O eq $_} @{$program -> {SKIP_OS}}) { + skip "Your OS uses different quoting."; + next; + } + + map {s/\$datafile/$datafile/} @{$program -> {ARGS}}; + $program -> {EXPECT} = $JaPH unless exists $program -> {EXPECT}; + $program -> {EXPECT} =~ s/\$JaPH_s\b/$JaPH_s/g; + $program -> {EXPECT} =~ s/\$JaPh_c\b/$JaPh_c/g; + $program -> {EXPECT} =~ s/\$JaPh\b/$JaPh/g; + chomp ($program -> {EXPECT}, @{$program -> {SWITCHES}}, + @{$program -> {ARGS}}); + fresh_perl_is ($program -> {CODE}, + $program -> {EXPECT}, + {switches => $program -> {SWITCHES}, + args => $program -> {ARGS}, + verbose => 0}, + $program -> {COMMENT}); + } +} + +{ + my $progfile = "progtmp000"; + 1 while -f ++ $progfile; + END {unlink_all $progfile} + + my @programs = (<< ' --', << ' --'); +#!./perl -- # No trailing newline after the last line! +BEGIN{$|=$SIG{__WARN__}=sub{$_=$_[0];y-_- -;print/(.)"$/;seek _,-open(_ +,"+<$0"),2;truncate _,tell _;close _;exec$0}}//rekcaH_lreP_rehtona_tsuJ + -- +#!./perl -- # Remove trailing newline! +BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/; +truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ + -- + chomp @programs; + + my $i = 1; + foreach my $program (@programs) { + open my $fh => "> $progfile" or die "Failed to open $progfile: $!\n"; + print $fh $program; + close $fh or die "Failed to close $progfile: $!\n"; + + chmod 0755 => $progfile or die "Failed to chmod $progfile: $!\n"; + my $command = "./$progfile"; + $command .= ' 2>&1' unless $^O eq 'MacOS'; + my $output = `$command`; + + $i ++; + is ($output, $JaPH, "Self correcting code $i"); + + $output = `$command`; + is ($output, "", "Self corrected code $i"); + } +} + +__END__ +####### Funky loop 1. +$_ = q ;4a75737420616e6f74686572205065726c204861636b65720as;; + for (s;s;s;s;s;s;s;s;s;s;s;s) + {s;(..)s?;qq qprint chr 0x$1 and \161 ssq;excess;} + +####### Funky loop 2. +$_ = q *4a75737420616e6f74686572205065726c204861636b65720a*; +for ($*=******;$**=******;$**=******) {$**=*******s*..*qq} +print chr 0x$& and q +qq}*excess********} + +####### Funky loop 3. +$_ = q *4a75737420616e6f74686572205065726c204861636b65720a*; +for ($*=******;$**=******;$**=******) {$**=*******s*..*qq} +print chr 0x$& and q +qq}*excess********} + +####### Funky loop 4. +$_ = q ?4a75737420616e6f74686572205065726c204861636b65720as?;??; +for (??;(??)x??;??) + {??;s;(..)s?;qq ?print chr 0x$1 and \161 ss?;excess;??} +SKIP: Abuses a fixed bug. + +####### Funky loop 5. +for (s??4a75737420616e6f74686572205065726c204861636b65720as?;??;??) + {s?(..)s\??qq \?print chr 0x$1 and q ss\??excess} +SKIP: Abuses a fixed bug. + +####### Funky loop 6. +$a = q 94a75737420616e6f74686572205065726c204861636b65720a9 and +${qq$\x5F$} = q 97265646f9 and s g..g; +qq e\x63\x68\x72\x20\x30\x78$&eggee; +{eval if $a =~ s e..eqq qprint chr 0x$& and \x71\x20\x71\x71qeexcess} + +####### Roman Dates. +@r=reverse(M=>(0)x99=>CM=>(0)x399=>D=>(0)x99=>CD=>( +0)x299=>C=>(0)x9=>XC=>(0)x39=>L=>(0)x9=>XL=>(0)x29=>X=>IX=>0=>0=>0=>V=>IV=>0=>0 +=>I=>$==-2449231+gm_julian_day+time);do{until($=<$#r){$_.=$r[$#r];$=-=$#r}for(; +!$r[--$#r];){}}while$=;$,="\x20";print+$_=>September=>MCMXCIII=>=>=>=>=>=>=>=> +SWITCHES +-MTimes::JulianDay +-l +SKIP: Times::JulianDay not part of the main distribution. + +####### Autoload 1. +sub _'_{$_'_=~s/$a/$_/}map{$$_=$Z++}Y,a..z,A..X;*{($_::_=sprintf+q=%X==>"$A$Y". +"$b$r$T$u")=~s~0~O~g;map+_::_,U=>T=>L=>$Z;$_::_}=*_;sub _{print+/.*::(.*)/s};;; +*{chr($b*$e)}=*_'_;*__=*{chr(1<<$e)}; # Perl 5.6.0 broke this... +_::_(r(e(k(c(a(H(__(l(r(e(P(__(r(e(h(t(o(n(a(__(t(us(J()))))))))))))))))))))))) +EXPECT: Just__another__Perl__Hacker + +####### Autoload 2. +$"=$,;*{;qq{@{[(A..Z)[qq[0020191411140003]=~m[..]g]]}}}=*_=sub{print/::(.*)/}; +$\=$/;q->(); + +####### Autoload 3. +$"=$,;*{;qq{@{[(A..Z)[qq[0020191411140003]=~m[..]g]]}}}=*_; +sub _ {push @_ => /::(.*)/s and goto &{ shift}} +sub shift {print shift; @_ and goto &{+shift}} +Hack ("Just", "Perl ", " ano", "er\n", "ther "); # YYYYMMDD + +####### Autoload 4. +$, = " "; sub AUTOLOAD {($AUTOLOAD =~ /::(.*)/) [0];} +print+Just (), another (), Perl (), Hacker (); + +####### Look ma! No letters! +$@="\145\143\150\157\040\042\112\165\163\164\040\141\156\157\164". + "\150\145\162\040\120\145\162\154\040\110\141\143\153\145\162". + "\042\040\076\040\057\144\145\166\057\164\164\171";`$@` +SKIP: Unix specific + +####### sprintf fun 1. +sub f{sprintf$_[0],$_[1],$_[2]}print f('%c%s',74,f('%c%s',117,f('%c%s',115,f( +'%c%s',116,f('%c%s',32,f('%c%s',97,f('%c%s',0x6e,f('%c%s',111,f('%c%s',116,f( +'%c%s',104,f('%c%s',0x65,f('%c%s',114,f('%c%s',32,f('%c%s',80,f('%c%s',101,f( +'%c%s',114,f('%c%s',0x6c,f('%c%s',32,f('%c%s',0x48,f('%c%s',97,f('%c%s',99,f( +'%c%s',107,f('%c%s',101,f('%c%s',114,f('%c%s',10,))))))))))))))))))))))))) + +####### sprintf fun 2. +sub f{sprintf'%c%s',$_[0],$_[1]}print f(74,f(117,f(115,f(116,f(32,f(97, +f(110,f(111,f(116,f(104,f(0x65,f(114,f(32,f(80,f(101,f(114,f(0x6c,f(32, +f(0x48,f(97,f(99,f(107,f(101,f(114,f(10,q ff))))))))))))))))))))))))) + +####### Hanoi. +%0=map{local$_=$_;reverse+chop,$_}ABC,ACB,BAC,BCA,CAB,CBA;$_=3 .AC;1while+ +s/(\d+)((.)(.))/($0=$1-1)?"$0$3$0{$2}1$2$0$0{$2}$4":"$3 => $4\n"/xeg;print +EXPECT +A => C +A => B +C => B +A => C +B => A +B => C +A => C + +####### Funky -p 1 +}{$_=$. +SWITCHES: -wlp +ARGS: $datafile +EXPECT: 6 + +####### Funky -p 2 +}$_=$.;{ +SWITCHES: -wlp +ARGS: $datafile +EXPECT: 6 + +####### Funky -p 3 +}{$_=$.}{ +SWITCHES: -wlp +ARGS: $datafile +EXPECT: 6 + +####### Funky -p 4 +}{*_=*.}{ +SWITCHES: -wlp +ARGS: $datafile +EXPECT: 6 + +####### Funky -p 5 +}for($.){print +SWITCHES: -wln +ARGS: $datafile +EXPECT: 6 + +####### Funky -p 6 +}{print$. +SWITCHES: -wln +ARGS: $datafile +EXPECT: 6 + +####### Funky -p 7 +}print$.;{ +SWITCHES: -wln +ARGS: $datafile +EXPECT: 6 + +####### Abusing -M +1 +SWITCHES +-Mstrict='}); print "Just another Perl Hacker"; ({' +-l +SKIP_OS: VMS +MSWin32 +NetWare + +####### rand +srand 123456;$-=rand$_--=>@[[$-,$_]=@[[$_,$-]for(reverse+1..(@[=split +//=>"IGrACVGQ\x02GJCWVhP\x02PL\x02jNMP"));print+(map{$_^q^"^}@[),"\n" +SKIP: Solaris specific. + +####### print and __PACKAGE__ +package Just_another_Perl_Hacker; sub print {($_=$_[0])=~ s/_/ /g; + print } sub __PACKAGE__ { & + print ( __PACKAGE__)} & + __PACKAGE__ + ( ) + +####### Decorations. +* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +/ / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / +% % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %; +BEGIN {% % = ($ _ = " " => print "Just another Perl Hacker\n")} + +####### Tie 1 +sub J::FETCH{Just }$_.='print+"@{[map';sub J::TIESCALAR{bless\my$J,J} +sub A::FETCH{another}$_.='{tie my($x),$';sub A::TIESCALAR{bless\my$A,A} +sub P::FETCH{Perl }$_.='_;$x}qw/J A P';sub P::TIESCALAR{bless\my$P,P} +sub H::FETCH{Hacker }$_.=' H/]}\n"';eval;sub H::TIESCALAR{bless\my$H,H} + +####### Tie 2 +package Z;use overload'""'=>sub{$b++?Hacker:another}; +sub TIESCALAR{bless\my$y=>Z}sub FETCH{$a++?Perl:Just} +$,=$";my$x=tie+my$y=>Z;print$y,$x,$y,$x,"\n";#Abigail +EXPECT: $JaPH_s + +####### Tie 3 +sub A::TIESCALAR{bless\my$x=>A};package B;@q[0..3]=qw/Hacker Perl +another Just/;use overload'""'=>sub{pop @q};sub A::FETCH{bless\my +$y=>B}; tie my $shoe => qq 'A';print "$shoe $shoe $shoe $shoe\n"; + +####### Tie 4 +sub A::TIESCALAR{bless\my$x=>'A'};package B;@q=qw/Hacker Perl +another Just/;use overload'""',sub{pop @q};sub A::FETCH{bless +\my $y=>B};tie my$shoe=>'A';print"$shoe $shoe $shoe $shoe\n"; + +####### Tie 5 +tie $" => A; $, = " "; $\ = "\n"; @a = ("") x 2; print map {"@a"} 1 .. 4; +sub A::TIESCALAR {bless \my $A => A} # Yet Another silly JAPH by Abigail +sub A::FETCH {@q = qw /Just Another Perl Hacker/ unless @q; shift @q} +SKIP: Pending a bug fix. + +####### Prototype fun 1 +sub camel (^#87=i@J&&&#]u'^^s]#'#={123{#}7890t[0.9]9@+*`"'***}A&&&}n2o}00}t324i; +h[{e **###{r{+P={**{e^^^#'#i@{r'^=^{l+{#}H***i[0.9]&@a5`"':&^;&^,*&^$43##@@####; +c}^^^&&&k}&&&}#=e*****[]}'r####'`=437*{#};::'1[0.9]2@43`"'*#==[[.{{],,,1278@#@); +print+((($llama=prototype'camel')=~y|+{#}$=^*&[0-9]i@:;`"',.| |d)&&$llama."\n"); +SKIP: Abuses a fixed bug. + +####### Prototype fun 2 +print prototype sub "Just another Perl Hacker" {}; + +####### Prototype fun 3 +sub _ "Just another Perl Hacker"; print prototype \&_ + +####### Split 1 + split // => '"'; +${"@_"} = "/"; split // => eval join "+" => 1 .. 7; +*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}}; +%{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}}; +EXPECT: $JaPH_s + +####### Split 2 +$" = "/"; split // => eval join "+" => 1 .. 7; +*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}}; +%_ = (Just => another => Perl => Hacker); &{%_}; +EXPECT: $JaPH_s + +####### Split 3 +$" = "/"; split $, => eval join "+" => 1 .. 7; +*{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}}; +%{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}}; +EXPECT: $JaPH_s + +####### Here documents 1 +$_ = "\x3C\x3C\x45\x4F\x54"; s/< ("a" .. "z") [8, 13, 19, 4, 6, 4, 17]} = sub + {["", "Just ", "another ", "Perl ", "Hacker\n"] -> [shift]}; + $^H = hex join "" => reverse map {int ($_ / 2)} 0 .. 4} +print 1, 2, 3, 4; + +####### Overloaded constants 4 +BEGIN {$^H {join "" => ("a" .. "z") [8, 13, 19, 4, 6, 4, 17]} = sub + {["", "Just ", "another ", "Perl ", "Hacker"] -> [shift]}; + $^H = hex join "" => reverse map {int ($_ / 2)} 0 .. 4} +print 1, 2, 3, 4, "\n"; + +####### Overloaded constants 5 +BEGIN {my $x = "Knuth heals rare project\n"; + $^H {integer} = sub {my $y = shift; $_ = substr $x => $y & 0x1F, 1; + $y > 32 ? uc : lc}; $^H = hex join "" => 2, 1, 1, 0, 0} +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; + +####### v-strings 1 +print v74.117.115.116.32; +print v97.110.111.116.104.101.114.32; +print v80.101.114.108.32; +print v72.97.99.107.101.114.10; + +####### v-strings 2 +print 74.117.115.116.32; +print 97.110.111.116.104.101.114.32; +print 80.101.114.108.32; +print 72.97.99.107.101.114.10; + +####### v-strings 3 +print v74.117.115.116.32, v97.110.111.116.104.101.114.32, + v80.101.114.108.32, v72.97.99.107.101.114.10; + +####### v-strings 4 +print 74.117.115.116.32, 97.110.111.116.104.101.114.32, + 80.101.114.108.32, 72.97.99.107.101.114.10; + +####### v-strings 5 +print v74.117.115.116.32.97.110.111.116.104.101.114. + v32.80.101.114.108.32.72.97.99.107.101.114.10; + +####### v-strings 6 +print 74.117.115.116.32.97.110.111.116.104.101.114. + 32.80.101.114.108.32.72.97.99.107.101.114.10; + +####### Symbolic references. +map{${+chr}=chr}map{$_=>$_^ord$"}$=+$]..3*$=/2; +print "$J$u$s$t $a$n$o$t$h$e$r $P$e$r$l $H$a$c$k$e$r\n"; + +####### $; fun +$; # A lone dollar? +=$"; # Pod? +$; # The return of the lone dollar? +{Just=>another=>Perl=>Hacker=>} # Bare block? +=$/; # More pod? +print%; # No right operand for %? + +####### @; fun +@;=split//=>"Joel, Preach sartre knuth\n";$;=chr 65;%;=map{$;++=>$_} +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 +;print@;[@;{A..Z}]; +EXPECT: $JaPh_c + +####### %; fun +$;=$";$;{Just=>another=>Perl=>Hacker=>}=$/;print%; + +####### &func; +$_ = "\112\165\163\1648\141\156\157\164\150\145\1628\120\145" + . "\162\1548\110\141\143\153\145\162\0128\177" and &japh; +sub japh {print "@_" and return if pop; split /\d/ and &japh} + +####### magic goto. +sub _ {$_ = shift and y/b-yB-Y/a-yB-Y/ xor !@ _? + exit print : + print and push @_ => shift and goto &{(caller (0)) [3]}} + split // => "KsvQtbuf fbsodpmu\ni flsI " xor & _ + +####### $: fun 1 +:$:=~s:$":Just$&another$&:;$:=~s: +:Perl$"Hacker$&:;chop$:;print$:#: + +####### $: fun 2 + :;$:=~s: +-:;another Perl Hacker + :;chop +$:;$:=~y + :;::d;print+Just. +$:; + +####### $: fun 3 + :;$:=~s: +-:;another Perl Hacker + :;chop +$:;$:=~y:;::d;print+Just.$: + +####### $! +s[$,][join$,,(split$,,($!=85))[(q[0006143730380126152532042307]. +q[41342211132019313505])=~m[..]g]]e and y[yIbp][HJkP] and print; +SKIP: Platform dependent. + +####### die 1 +eval {die ["Just another Perl Hacker"]}; print ${$@}[$#{@${@}}] + +####### die 2 +eval {die ["Just another Perl Hacker\n"]}; print ${$@}[$#{@${@}}] + +####### die 3 +eval {die ["Just another Perl Hacker"]}; print ${${@}}[$#{@{${@}}}] + +####### die 4 +eval {die ["Just another Perl Hacker\n"]}; print ${${@}}[$#{@{${@}}}] + +####### die 5 +eval {die [[qq [Just another Perl Hacker]]]};; print +${${${@}}[$#{@{${@}}}]}[$#{${@{${@}}}[$#{@{${@}}}]}] + +####### Closure returning itself. +$_ = "\nrekcaH lreP rehtona tsuJ"; my $chop; $chop = sub {print chop; $chop}; +$chop -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () +-> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () -> () + +####### Special blocks 1 +BEGIN {print "Just " } +CHECK {print "another "} +INIT {print "Perl " } +END {print "Hacker\n"} + +####### Special blocks 2 +END {print "Hacker\n"} +INIT {print "Perl " } +CHECK {print "another "} +BEGIN {print "Just " } + +####### Recursive regex. + my $qr = qr/^.+?(;).+?\1|;Just another Perl Hacker;|;.+$/; + $qr =~ s/$qr//g; +print $qr, "\n"; + +####### use lib 'coderef' +use lib sub {($\) = split /\./ => pop; print $"}; +eval "use Just" || eval "use another" || eval "use Perl" || eval "use Hacker"; +EXPECT + Just another Perl Hacker