On 4/18/06, Nicholas Clark <[EMAIL PROTECTED]> wrote:
> Last time I checked the core has "6 TESTS UNEXPECTEDLY SUCCEEDED"
> What's the expected number of unexpected successes?
> Can it be made to be zero, even though we're testing the test modules?
>
> If so, I think that that would be useful, as it would mean that any (real)
> TODO test that unexpectedly started passing would be noticed.
>
> I bring this up because we seem to have inadvertently fixed really old regexp
> bugs that we didn't have a test case for, but I realise that right now adding
> TODO tests wouldn't actually have been *that* useful - if a TODO passes we
> don't notice.
>
> It would be good if we were in a position to notice. I'm not sure how much
> work that would be.
With the attached (hacky) patch i get the following results:
All tests successful (6 subtests UNEXPECTEDLY SUCCEEDED), 58 tests and
388 subtests skipped.
Passed Test Stat Wstat Total Pass Passed List of Passed
-------------------------------------------------------------------------------
../ext/B/t/optree_constants.t 30 6 20.00% 14 16 19 21 23 28
Files=1224, Tests=164595, 872 wallclock secs ( 0.00 cusr + 0.00 csys
= 0.00 CPU)
cd ..\win32
So its ext/B/t/optree_constant.t thats unexpected happy.
BTW, the patch only shows TODO pass status when no failures occur.
Oh and obviously all of Test::Harness'es tests pass. :-)
cheers,
Yves
--
perl -Mre=debug -e "/just|another|perl|hacker/"
diff -wurd sync/lib/Test/Harness.pm 27865/lib/Test/Harness.pm
--- sync/lib/Test/Harness.pm 2005-09-29 01:28:56.000000000 +0200
+++ 27865/lib/Test/Harness.pm 2006-04-18 22:39:09.618240400 +0200
@@ -218,8 +218,8 @@
local ($\, $,);
- my($tot, $failedtests) = _run_all_tests(@tests);
- _show_results($tot, $failedtests);
+ my($tot, $failedtests,$todo_passed) = _run_all_tests(@tests);
+ _show_results($tot, $failedtests, $todo_passed);
my $ok = _all_ok($tot);
@@ -317,7 +317,7 @@
_autoflush(\*STDOUT);
_autoflush(\*STDERR);
- my(%failedtests);
+ my(%failedtests,%todo_passed);
# Test-wide totals.
my(%tot) = (
@@ -372,11 +372,16 @@
# state of the current test.
my @failed = grep { !$results{details}[$_-1]{ok} }
[EMAIL PROTECTED];
+ my @todo_pass = grep { $results{details}[$_-1]{ok} &&
+ $results{details}[$_-1]{type} eq 'todo' }
+ [EMAIL PROTECTED];
+
my %test = (
ok => $results{ok},
'next' => $Strap->{'next'},
max => $results{max},
failed => [EMAIL PROTECTED],
+ todo_pass => [EMAIL PROTECTED],
bonus => $results{bonus},
skipped => $results{skip},
skip_reason => $results{skip_reason},
@@ -398,8 +403,20 @@
my @msg;
push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")
if $test{skipped};
- push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded")
- if $test{bonus};
+ if ($test{bonus}) {
+ my ($txt, $canon) = _canondetail($test{max},$test{skipped},'Todo passed',
+ @{$test{todo_pass}});
+ $todo_passed{$tfile} = { canon => $canon,
+ max => $test{max},
+ failed => $test{bonus},
+ name => $tfile,
+ percent => 100*$test{bonus}/$test{max},
+ estat => '',
+ wstat => '',
+ };
+
+ push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded\n$txt");
+ }
print "$test{ml}ok$elapsed\n ".join(', ', @msg)."\n";
}
elsif ( $test{max} ) {
@@ -436,7 +453,7 @@
}
elsif($results{seen}) {
if (@{$test{failed}} and $test{max}) {
- my ($txt, $canon) = _canonfailed($test{max},$test{skipped},
+ my ($txt, $canon) = _canondetail($test{max},$test{skipped},'Failed',
@{$test{failed}});
print "$test{ml}$txt";
$failedtests{$tfile} = { canon => $canon,
@@ -492,7 +509,7 @@
$Strap->_restore_PERL5LIB;
- return(\%tot, \%failedtests);
+ return(\%tot, \%failedtests, \%todo_passed);
}
=item B<_mk_leader>
@@ -551,13 +568,23 @@
sub _show_results {
- my($tot, $failedtests) = @_;
+ my($tot, $failedtests, $todo_passed) = @_;
+
+
my $pct;
my $bonusmsg = _bonusmsg($tot);
if (_all_ok($tot)) {
print "All tests successful$bonusmsg.\n";
+ if ($tot->{bonus}) {
+ my($fmt_top, $fmt) = _create_fmts("Passed",$todo_passed);
+ # Now write to formats
+ for my $script (sort keys %{$todo_passed||{}}) {
+ $Curtest = $todo_passed->{$script};
+ write;
+ }
+ }
}
elsif (!$tot->{tests}){
die "FAILED--no tests were run for some reason.\n";
@@ -574,7 +601,7 @@
$tot->{max} - $tot->{ok}, $tot->{max},
$percent_ok;
- my($fmt_top, $fmt) = _create_fmts($failedtests);
+ my($fmt_top, $fmt) = _create_fmts("Failed",$failedtests);
# Now write to formats
for my $script (sort keys %$failedtests) {
@@ -698,7 +725,6 @@
. ($tot->{sub_skipped} != 1 ? 's' : '')
. " skipped";
}
-
return $bonusmsg;
}
@@ -723,7 +749,7 @@
else {
push @{$test->{failed}}, $test->{'next'}..$test->{max};
$failed = @{$test->{failed}};
- (my $txt, $canon) = _canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
+ (my $txt, $canon) = _canondetail($test->{max},$test->{skipped},'Failed',@{$test->{failed}});
$percent = 100*(scalar @{$test->{failed}})/$test->{max};
print "DIED. ",$txt;
}
@@ -738,11 +764,11 @@
sub _create_fmts {
- my($failedtests) = @_;
-
- my $failed_str = "Failed Test";
- my $middle_str = " Stat Wstat Total Fail Failed ";
- my $list_str = "List of Failed";
+ my($type,$failedtests) = @_;
+ my $short=substr($type,0,4);
+ my $failed_str = "$type Test";
+ my $middle_str = " Stat Wstat Total $short $type ";
+ my $list_str = "List of $type";
# Figure out our longest name string for formatting purposes.
my $max_namelen = length($failed_str);
@@ -790,18 +816,19 @@
return($fmt_top, $fmt);
}
-sub _canonfailed ($$@) {
- my($max,$skipped,@failed) = @_;
+sub _canondetail ($$$@) {
+ my($max,$skipped,$type,@detail) = @_;
my %seen;
- @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
- my $failed = @failed;
+ @detail = sort {$a <=> $b} grep !$seen{$_}++, @detail;
+ my $detail = @detail;
my @result = ();
my @canon = ();
my $min;
- my $last = $min = shift @failed;
+ my $last = $min = shift @detail;
my $canon;
- if (@failed) {
- for (@failed, $failed[-1]) { # don't forget the last one
+ my ($uc_type)=uc($type);
+ if (@detail) {
+ for (@detail, $detail[-1]) { # don't forget the last one
if ($_ > $last+1 || $_ == $last) {
push @canon, ($min == $last) ? $last : "$min-$last";
$min = $_;
@@ -809,24 +836,26 @@
$last = $_;
}
local $" = ", ";
- push @result, "FAILED tests @canon\n";
+ push @result, "$uc_type tests @canon\n";
$canon = join ' ', @canon;
}
else {
- push @result, "FAILED test $last\n";
+ push @result, "$uc_type test $last\n";
$canon = $last;
}
- push @result, "\tFailed $failed/$max tests, ";
+ return (join("", @result), $canon)
+ if $type=~/todo/i;
+ push @result, "\t$type $detail/$max tests, ";
if ($max) {
- push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
+ push @result, sprintf("%.2f",100*(1-$detail/$max)), "% okay";
}
else {
push @result, "?% okay";
}
my $ender = 's' x ($skipped > 1);
if ($skipped) {
- my $good = $max - $failed - $skipped;
+ my $good = $max - $detail - $skipped;
my $skipmsg = " (less $skipped skipped test$ender: $good okay, ";
if ($max) {
my $goodper = sprintf("%.2f",100*($good/$max));
Only in 27865/lib/Test: Harness.pm.bak
