This patch modifies Parrot::Test to goto the Test::More subs, thereby
giving you _useful_ information on where your problem was.
Unfortunately, this precludes unlinking the files only if the test was
unsuccessful; if you need to see those files, you can just set
$ENV{POSTMORTEM} and they'll be left in place.

--Brent Dax
[EMAIL PROTECTED]
Configure pumpking for Perl 6

"Nothing important happened today."
    --George III of England's diary entry for 4-Jul-1776

--- ..\..\parrot-cvs\parrot\Parrot\Test.pm      Thu Dec 20 01:09:02 2001
+++ Parrot\Test.pm      Mon Jan  7 02:45:20 2002
@@ -1,5 +1,26 @@
 #

+package Parrot::Test::EvilSubWrapper;
+#This chamber of horrors allows us to goto a subroutine
+#  and still be able to perform actions afterwards.
+#  Inspired by something I read about on the Conway
+#  Channel.  --BD  01/07/2002
+
+sub new {
+       my($class, $action, $destruct)=@_;
+
+       bless {action => $action, destruct => $destruct}, $class;
+}
+
+sub subr {
+       $_[0]->{action}
+}
+
+sub DESTROY {
+       goto &{$_[0]->{destruct}};
+}
+
+
 package Parrot::Test;

 use strict;
@@ -72,9 +93,21 @@
     close OUTPUT;

     @_ = ( $prog_output, $output, $desc );
-    #goto &{"Test::More::$i"};
-    my $ok = &{"Test::More::$i"}( @_ );
-    if( $ok ) { foreach my $i ( $as_f, $by_f, $out_f ) { unlink $i } }
+
+    my $func=new Parrot::Test::EvilSubWrapper(
+        \&{"Test::More::$i"},
+        sub {
+               unless($ENV{POSTMORTERM}) {
+                       foreach my $i ( $as_f, $by_f, $out_f ) {
+                               unlink $i;
+                       }
+               }
+       }
+    );
+
+    goto &{$func->subr};
+#    my $ok = &{"Test::More::$i"}( @_ );
+#    if($ok) { foreach my $i ( $as_f, $by_f, $out_f ) { unlink $i } }
   }
 }

Reply via email to