Since Test::Builder::details() is marked UNIMPLMENTED in 0.45, it seemed like a useful method to add. This patch does so, with the appropriate tests in t/Builder.t. It works as per my understanding of the Test::Builder POD.
I very nearly updated the copyright notice in Test::Builder, while I was at it. -- c diff -ur Test-Simple-0.45.old/lib/Test/Builder.pm Test-Simple-0.45/lib/Test/Builder.pm --- Test-Simple-0.45.old/lib/Test/Builder.pm Wed Jun 19 15:27:04 2002 +++ Test-Simple-0.45/lib/Test/Builder.pm Fri Jul 5 22:44:24 2002 @@ -281,12 +281,14 @@ my $todo = $self->todo($pack); my $out; + my $result = {}; + unless( $test ) { $out .= "not "; - $Test_Results[$Curr_Test-1] = $todo ? 1 : 0; + @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 ); } else { - $Test_Results[$Curr_Test-1] = 1; + @$result{ 'ok', 'actual_ok' } = ( 1, $test ); } $out .= "ok"; @@ -295,13 +297,17 @@ if( defined $name ) { $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness. $out .= " - $name"; + $result->{name} = $name; } if( $todo ) { my $what_todo = $todo; $out .= " # TODO $what_todo"; + $result->{reason} = $what_todo; } + $result->{type} = 'todo'; + $Test_Results[$Curr_Test-1] = $result; $out .= "\n"; $self->_print($out); @@ -630,7 +636,12 @@ lock($Curr_Test); $Curr_Test++; - $Test_Results[$Curr_Test-1] = 1; + $Test_Results[$Curr_Test-1] = { + ok => 1, + actual_ok => 0, + type => 'skip', + reason => $why, + }; my $out = "ok"; $out .= " $Curr_Test" if $self->use_numbers; @@ -666,7 +677,12 @@ lock($Curr_Test); $Curr_Test++; - $Test_Results[$Curr_Test-1] = 1; + $Test_Results[$Curr_Test-1] = { + ok => 1, + actual_ok => 0, + type => 'todo_skip', + reason => $why, + }; my $out = "not ok"; $out .= " $Curr_Test" if $self->use_numbers; @@ -1026,7 +1042,8 @@ if( $num > @Test_Results ) { my $start = @Test_Results ? $#Test_Results : 0; for ($start..$num-1) { - $Test_Results[$_] = 1; + @{ $Test_Results[$_]}{qw( ok actual_ok reason )} = + ( 1, 0, 'incrementing test number' ); } } } @@ -1048,10 +1065,10 @@ sub summary { my($self) = shift; - return @Test_Results; + return map { $_->{ok} } @Test_Results; } -=item B<details> I<UNIMPLEMENTED> +=item B<details> my @tests = $Test->details; @@ -1065,6 +1082,12 @@ reason => reason for the above (if any) }; +=cut + +sub details { + return @Test_Results; +} + =item B<todo> my $todo_reason = $Test->todo; @@ -1218,7 +1241,7 @@ $Test_Results[$Expected_Tests-1] = undef unless defined $Test_Results[$Expected_Tests-1]; - my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1]; + my $num_failed = grep !$_->{ok}, @Test_Results[0..$Expected_Tests-1]; $num_failed += abs($Expected_Tests - @Test_Results); if( $Curr_Test < $Expected_Tests ) { diff -ur Test-Simple-0.45.old/t/Builder.t Test-Simple-0.45/t/Builder.t --- Test-Simple-0.45.old/t/Builder.t Wed Jun 19 15:18:49 2002 +++ Test-Simple-0.45/t/Builder.t Fri Jul 5 22:43:07 2002 @@ -7,10 +7,11 @@ } } +use vars '$TODO'; use Test::Builder; my $Test = Test::Builder->new; -$Test->plan( tests => 7 ); +$Test->plan( tests => 26 ); my $default_lvl = $Test->level; $Test->level(0); @@ -28,3 +29,38 @@ print "ok $test_num - current_test() set\n"; $Test->ok( 1, 'counter still good' ); + +my @tests = $Test->summary(); +$Test->ok( (grep { ! ref $_ } @tests ) == 7, + 'summary() should return only booleans' ); +$Test->skip( 'i need a skip' ); +{ + local $TODO = 'i need a todo'; + $Test->ok( 0, 'a test to todo!' ); +} +$Test->todo_skip( 'i need both' ); + +my @details = $Test->details(); +$Test->ok( @details == 11, + 'details() should return a list of all test details'); + +foreach my $detail ([ 0, 'ok', '1'], [ 1, 'name', 'level()' ]) { + my ($number, $field, $value) = @$detail; + $Test->ok( $details[$number]{$field} eq $value, + "... with the correct '$field' fields" ); +} + +$Test->ok( $details[8]{ok} == 1, '... marking skipped tests as ok' ); +$Test->ok( $details[8]{actual_ok} == 0, '... but actually false' ); +$Test->ok( $details[8]{type} eq 'skip', "... with the 'skip' type" ); +$Test->ok( $details[8]{reason} eq 'i need a skip', '... and the skip label' ); + +$Test->ok( $details[9]{ok} == 1, '... marking todo tests as ok' ); +$Test->ok( $details[9]{actual_ok} == 0, '... and saving their actual truth' ); +$Test->ok( $details[9]{type} eq 'todo', "... with the 'todo' type" ); +$Test->ok( $details[9]{reason} eq 'i need a todo', '... and the todo label' ); + +$Test->ok( $details[10]{ok} == 1, '... marking todo_skip tests as ok' ); +$Test->ok( $details[10]{actual_ok} == 0, '... and saving their actual truth' ); +$Test->ok( $details[10]{type} eq 'todo_skip', "... with the 'todo_skip' type" ); +$Test->ok( $details[10]{reason} eq 'i need both', '... and its label' );