[PATCH Test::Harness::Straps] Add Diagnostic Output to Straps Results

[chromatic]

Hi all,

As threatened in comments on Ovid's journal about colorizing test output
(and displaying better diagnostics on success or failure), here's a
small patch to Test::Harness::Straps to collect the diagnostic
information currently dumped to STDERR and to store it in the test data
structure for Straps users to collect:

        http://use.perl.org/~Ovid/journal/22899

I haven't added a flag to enable or disable this and
Test::Harness::Straps itself could use some severe refactoring, but this
is just a first pass to see if it's something other people might like.

I've also attached a patch to qtest to show how to use it.

Enjoy,
-- c



diff -ur lib/Test/Harness/Straps.pm~ lib/Test/Harness/Straps.pm
--- lib/Test/Harness/Straps.pm~    2004-12-31 13:28:32.000000000 -0800
+++ lib/Test/Harness/Straps.pm    2005-01-26 15:30:41.000000000 -0800
@@ -8,6 +8,7 @@
 use Config;
 $VERSION = '0.20';
 
+use IPC::Open3;
 use Test::Harness::Assert;
 use Test::Harness::Iterator;
 
@@ -228,6 +229,13 @@
         $type = 'bailout';
         $self->{saw_bailout} = 1;
     }
+    elsif ($result{number} and my $extra = $self->_is_extra_line( $line ))
+    {
+        my $test         = $totals->{details}[$result{number} - 1];
+        $test->{extra} ||=  '';
+        $test->{extra}  .= $extra;
+        $type = 'other';
+    }
     else {
         $type = 'other';
     }
@@ -237,6 +245,14 @@
     $self->{'next'} = $result{number} + 1 if $type eq 'test';
 }
 
+sub _is_extra_line
+{
+    my ($self, $line, $test) = @_;
+    return if index( $line, '# Looks like you failed' ) == 0;
+    $line =~ s/^#//;
+    return $line;
+}
+
 =head2 C<analyze_fh>
 
   my %results = $strap->analyze_fh($name, $test_filehandle);
@@ -282,13 +298,17 @@
 
     # *sigh* this breaks under taint, but open -| is unportable.
     my $line = $self->_command_line($file);
-    unless( open(FILE, "$line|") ) {
+    my $reader;
+
+    my $pid;
+    unless ($pid = open3( undef, $reader, $reader, $line ))
+    {
         print "can't run $file. $!\n";
         return;
-    }
+    }
 
-    my %results = $self->analyze_fh($file, \*FILE);
-    my $exit = close FILE;
+    my %results = $self->analyze_fh($file, $reader);
+    my $exit    = waitpid $pid, 0;
     $results{'wait'} = $?;
     if( $? && $self->{_is_vms} ) {
         eval q{use vmsish "status"; $results{'exit'} = $?};

--- qtest~	2005-01-26 15:37:32.000000000 -0800
+++ qtest	2005-01-26 15:37:26.000000000 -0800
@@ -43,7 +43,10 @@
 	{
 		$count++;
 		next if $test->{ok};
-		$report .= create_test_result( $count, @{ $test }{qw( name reason ) } );
+		$report .= create_test_result(
+			$count,
+			@{ $test }{qw( name reason extra ) }
+		);
 	}
 
 	return $report;
@@ -59,9 +62,9 @@
 
 sub create_test_result
 {
-	my ($number, $name, $reason)   = @_;
-	$name                          =~ s/^-\s*//;
-	$reason                      ||= '';
-	$reason                        = " ($reason)" if $reason;
-	return sprintf "\tTest #%d: %s%s\n", $number, $name, $reason;
+	my ($number, $name, $reason, $extra)  = @_;
+	$name                                 =~ s/^-\s*//;
+	$reason                             ||= '';
+	$reason                               = " ($reason)" if $reason;
+	return sprintf "\tTest #%d: %s%s\n%s", $number, $name, $reason, $extra;
 }