Skip Menu |
 

This queue is for tickets about the Test-Harness CPAN distribution.

Report information
The Basics
Id: 11325
Status: resolved
Priority: 0/
Queue: Test-Harness

People
Owner: andy [...] hexten.net
Requestors: chromatic [...] wgz.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)

Attachments


Subject: [PATCH lib/Test/Harness/Straps.pm] Collect and Report Diagnostic Output
Download (untitled) / with headers
text/plain 203b
This patch to Test::Harness::Straps allows the optional collection and reporting of diagnostic output as discussed on the perl-qa mailing list (http://www.nntp.perl.org/group/perl.qa/3499 and followups).
Download straps_diags.patch
text/x-diff 5.8k
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 19:39:40.000000000 -0800 @@ -8,6 +8,7 @@ use Config; $VERSION = '0.20'; +use IPC::Open3; use Test::Harness::Assert; use Test::Harness::Iterator; @@ -69,9 +70,10 @@ =cut sub new { - my $class = shift; + my ($class, %args) = @_; - my $self = bless {}, $class; + my $self = bless {}, $class; + $self->{extra} = 1 if $args{extra}; $self->_init; return $self; @@ -228,6 +230,13 @@ $type = 'bailout'; $self->{saw_bailout} = 1; } + elsif ($self->{extra} and my $extra = $self->_is_extra_line( $line )) + { + my $test = $totals->{details}[-1]; + $test->{extra} ||= ''; + $test->{extra} .= $extra; + $type = 'other'; + } else { $type = 'other'; } @@ -237,6 +246,14 @@ $self->{'next'} = $result{number} + 1 if $type eq 'test'; } +sub _is_extra_line +{ + my ($self, $line) = @_; + return if index( $line, '# Looks like you failed' ) == 0; + $line =~ s/^#\s//; + return $line; +} + =head2 C<analyze_fh> my %results = $strap->analyze_fh($name, $test_filehandle); @@ -282,13 +299,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'} = $?}; diff -ur MANIFEST~ MANIFEST --- MANIFEST~ 2004-12-31 13:28:32.000000000 -0800 +++ MANIFEST 2005-01-26 19:41:49.000000000 -0800 @@ -23,6 +23,7 @@ t/prove-globbing.t t/prove-switches.t t/strap-analyze.t +t/strap-analyze-extra.t t/strap.t t/test-harness.t --- /dev/null 1969-12-31 16:00:00.000000000 -0800 +++ t/strap-analyze-extra.t 2005-01-26 19:41:26.000000000 -0800 @@ -0,0 +1,133 @@ +#!/usr/bin/perl -w + +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir 't'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; + } +} + +use strict; +use Test::More; +use File::Spec; + +my $Curdir = File::Spec->curdir; +my $SAMPLE_TESTS = $ENV{PERL_CORE} + ? File::Spec->catdir($Curdir, 'lib', 'sample-tests') + : File::Spec->catdir($Curdir, 't', 'sample-tests'); + + +my $IsMacPerl = $^O eq 'MacOS'; +my $IsVMS = $^O eq 'VMS'; + +# VMS uses native, not POSIX, exit codes. +my $die_exit = $IsVMS ? 44 : 1; + +# We can only predict that the wait status should be zero or not. +my $wait_non_zero = 1; + +my %samples = ( + 'with_comments' =>{ + passing => 1, + 'exit' => 0, + 'wait' => 0, + + max => 5, + seen => 5, + + 'ok' => 5, + 'todo' => 4, + 'skip' => 0, + bonus => 2, + + details => [ { + 'ok' => 1, + actual_ok => 0, + extra => "Failed test 1 in t/todo.t at line 9 *TODO*\n", + type => 'todo' + }, + { + 'ok' => 1, + actual_ok => 1, + reason => 'at line 10 TODO?!)', + type => 'todo' + }, + { + 'ok' => 1, + actual_ok => 1, + }, + { + 'ok' => 1, + actual_ok => 0, + extra => "Test 4 got: '0' (t/todo.t at line 12 *TODO*)\n" + . " Expected: '1' (need more tuits)\n", + type => 'todo' + }, + { + 'ok' => 1, + actual_ok => 1, + reason => 'at line 13 TODO?!)', + extra => "woo\n", + type => 'todo' + }, + ]}, +); + +plan tests => (keys(%samples) * 5) + 3; + +use Test::Harness::Straps; + +$SIG{__WARN__} = sub { + warn @_ unless $_[0] =~ /^Enormous test number/ || + $_[0] =~ /^Can't detailize/ +}; + +for my $test ( sort keys %samples ) { + my $expect = $samples{$test}; + + for (0..$#{$expect->{details}}) { + $expect->{details}[$_]{type} = '' + unless exists $expect->{details}[$_]{type}; + $expect->{details}[$_]{name} = '' + unless exists $expect->{details}[$_]{name}; + $expect->{details}[$_]{reason} = '' + unless exists $expect->{details}[$_]{reason}; + } + + my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); + my $strap = Test::Harness::Straps->new( extra => 1 ); + isa_ok( $strap, 'Test::Harness::Straps' ); + my %results = $strap->analyze_file($test_path); + + is_deeply($results{details}, $expect->{details}, "$test details" ); + + delete $expect->{details}; + delete $results{details}; + + SKIP: { + skip '$? unreliable in MacPerl', 2 if $IsMacPerl; + + # We can only check if it's zero or non-zero. + is( !!$results{'wait'}, !!$expect->{'wait'}, 'wait status' ); + delete $results{'wait'}; + delete $expect->{'wait'}; + + # Have to check the exit status seperately so we can skip it + # in MacPerl. + is( $results{'exit'}, $expect->{'exit'} ); + delete $results{'exit'}; + delete $expect->{'exit'}; + } + + is_deeply(\%results, $expect, " the rest $test" ); +} # for %samples + +NON_EXISTENT_FILE: { + my $strap = Test::Harness::Straps->new; + isa_ok( $strap, 'Test::Harness::Straps' ); + ok( !$strap->analyze_file('I_dont_exist') ); + is( $strap->{error}, "I_dont_exist does not exist" ); +}
Obsoleted by 2.99


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.