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 } }
}
}
