Re: encoding neutral unpack

[p5sagit/p5-mst-13.2.git] / t / japh / abigail.t

diff --git a/t/japh/abigail.t b/t/japh/abigail.t
index c8412aa..98a26de 100644 (file)
--- a/t/japh/abigail.t
+++ b/t/japh/abigail.t
@@ -3,6 +3,25 @@
 #
 # Tests derived from Japhs.
 #
+# These test use obscure features of Perl, or surprising combinations
+# of features. The tests were added because in the past, they have
+# exposed several bugs in Perl.
+#
+# Some of these tests may actually (mis)use bugs or use undefined behaviour.
+# These tests are still useful - behavioural changes or bugfixes will be
+# noted, and a remark can be put in the documentation. (Don't forget to
+# disable the test!)
+#
+# Getting everything to run well on the myriad of platforms Perl runs on
+# is unfortunately not a trivial task.
+#
+# WARNING: these tests are obfuscated.  Do not get frustrated.
+# Ask Abigail <abigail@foad.org>, or use the Deparse or Concise
+# modules (the former parses Perl to Perl, the latter shows the
+# op syntax tree) like this:
+# ./perl -Ilib -MO=Deparse foo.pl
+# ./perl -Ilib -MO=Concise foo.pl
+#
 
 BEGIN {
     if (ord("A") == 193) {
@@ -15,6 +34,8 @@ BEGIN {
     undef &skip;
 }
 
+skip_all "Unhappy on MacOS" if $^O eq 'MacOS';
+
 #
 # ./test.pl does real evilness by jumping to a label.
 # This function copies the skip from ./test, omitting the goto.
@@ -121,7 +142,7 @@ plan tests => 130;
 {
     my $datafile = "datatmp000";
     1 while -f ++ $datafile;
-    END {unlink_all $datafile}
+    END {unlink_all $datafile if $datafile}
 
     open  MY_DATA, "> $datafile" or die "Failed to open $datafile: $!";
     print MY_DATA  << "    --";
@@ -174,8 +195,8 @@ plan tests => 130;
             next;
         }
 
+       chomp @{$program -> {SKIP_OS}};
         if (@{$program -> {SKIP_OS}}) {
-            chomp @{$program -> {SKIP_OS}};
             if (grep {$^O eq $_} @{$program -> {SKIP_OS}}) {
                 skip "Your OS uses different quoting.", 1;
                 next;
@@ -201,14 +222,14 @@ plan tests => 130;
 {
     my $progfile = "progtmp000";
     1 while -f ++ $progfile;
-    END {unlink_all $progfile}
+    END {unlink_all $progfile if $progfile}
 
     my @programs = (<< '    --', << '    --');
-#!./perl               --    # No trailing newline after the last line!    
+#!./perl
 BEGIN{$|=$SIG{__WARN__}=sub{$_=$_[0];y-_- -;print/(.)"$/;seek _,-open(_ 
 ,"+<$0"),2;truncate _,tell _;close _;exec$0}}//rekcaH_lreP_rehtona_tsuJ
     --
-#!./perl               --   # Remove trailing newline!
+#!./perl
 BEGIN{$SIG{__WARN__}=sub{$_=pop;y-_- -;print/".*(.)"/;  
 truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ
     --
@@ -237,13 +258,18 @@ truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ
         chmod 0755   => $progfile or die "Failed to chmod $progfile: $!\n";
         my $command  = "./$progfile";
            $command .= ' 2>&1' unless $^O eq 'MacOS';
-        my $output   = `$command`;
+        if ( $^O eq 'qnx' ) {
+          skip "#!./perl not supported in QNX4";
+          skip "#!./perl not supported in QNX4";
+        } else {
+          my $output   = `$command`;
 
-        $i ++;
-        is ($output, $JaPH, "Self correcting code $i");
+          is ($output, $JaPH, "Self correcting code $i");
 
-           $output   = `$command`;
-        is ($output, "",    "Self corrected code $i");
+                 $output   = `$command`;
+          is ($output, "",    "Self corrected code $i");
+        }
+        $i ++;
     }
 }
 
@@ -258,12 +284,14 @@ $_ = q *4a75737420616e6f74686572205065726c204861636b65720a*;
 for ($*=******;$**=******;$**=******) {$**=*******s*..*qq}
 print chr 0x$& and q
 qq}*excess********}
+SKIP_OS: qnx
 
 #######  Funky loop 3.
 $_ = q *4a75737420616e6f74686572205065726c204861636b65720a*;
 for ($*=******;$**=******;$**=******) {$**=*******s*..*qq}
 print chr 0x$& and q
 qq}*excess********}
+SKIP_OS: qnx
 
 #######  Funky loop 4.
 $_ = q ?4a75737420616e6f74686572205065726c204861636b65720as?;??;
@@ -449,6 +477,7 @@ SKIP: Abuses a fixed bug.
 
 #######  Prototype fun 2
 print prototype sub "Just another Perl Hacker" {};
+SKIP: Abuses a fixed bug.
 
 #######  Prototype fun 3
 sub _ "Just another Perl Hacker"; print prototype \&_
@@ -458,18 +487,21 @@ sub _ "Just another Perl Hacker"; print prototype \&_
 ${"@_"} = "/"; split // => eval join "+" => 1 .. 7;
 *{"@_"} = sub {foreach (sort keys %_)  {print "$_ $_{$_} "}};
 %{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}};
+SKIP: Hashes are now randomized.
 EXPECT: $JaPH_s
 
 #######  Split 2
 $" = "/"; split // => eval join "+" => 1 .. 7;
 *{"@_"} = sub {foreach (sort keys %_) {print "$_ $_{$_} "}};
 %_ = (Just => another => Perl => Hacker); &{%_};
+SKIP: Hashes are now randomized.
 EXPECT: $JaPH_s
 
 #######  Split 3
 $" = "/"; split $, => eval join "+" => 1 .. 7;
 *{"@_"} = sub  {foreach (sort keys %_) {print "$_ $_{$_} "}};
 %{"@_"} = %_ = (Just => another => Perl => Hacker); &{%{%_}};
+SKIP: Hashes are now randomized.
 EXPECT: $JaPH_s
 
 #######  Here documents 1
@@ -500,6 +532,7 @@ SWITCHES: -w
 #######  Overloaded constants 1
 BEGIN {$^H {q} = sub {pop and pop and print pop}; $^H = 2**4.2**12}
 "Just "; "another "; "Perl "; "Hacker";
+SKIP_OS: qnx
 
 #######  Overloaded constants 2
 BEGIN {$^H {q} = sub {$_ [1] =~ y/S-ZA-IK-O/q-tc-fe-m/d; $_ [1]}; $^H = 0x28100}