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' );
