From: Jarkko Hietaniemi Date: Mon, 31 Mar 2003 10:36:48 +0000 (+0000) Subject: Upgrade to Test::Harness 2.27_02. X-Git-Tag: perl-5.9.0~1703 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/a72fde192387945aae04c48f7d042b7b70c05b2f Upgrade to Test::Harness 2.27_02. p4raw-id: //depot/perl@19102 --- diff --git a/MANIFEST b/MANIFEST index 91b9a41..6a8c4de 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2487,17 +2487,20 @@ t/lib/sample-tests/head_end Test data for Test::Harness t/lib/sample-tests/head_fail Test data for Test::Harness t/lib/sample-tests/lone_not_bug Test data for Test::Harness t/lib/sample-tests/no_nums Test data for Test::Harness +t/lib/sample-tests/no_output Test data for Test::Harness t/lib/sample-tests/out_of_order Test data for Test::Harness +t/lib/sample-tests/segfault Test data for Test::Harness t/lib/sample-tests/shbang_misparse Test data for Test::Harness t/lib/sample-tests/simple Test data for Test::Harness t/lib/sample-tests/simple_fail Test data for Test::Harness t/lib/sample-tests/skip Test data for Test::Harness -t/lib/sample-tests/skipall Test data for Test::Harness +t/lib/sample-tests/skip_nomsg Test data for Test::Harness +t/lib/sample-tests/skipall Test data for Test::Harness t/lib/sample-tests/skipall_nomsg Test data for Test::Harness -t/lib/sample-tests/skip_nomsg Test data for Test::Harness t/lib/sample-tests/taint Test data for Test::Harness t/lib/sample-tests/todo Test data for Test::Harness t/lib/sample-tests/todo_inline Test data for Test::Harness +t/lib/sample-tests/too_many Test data for Test::Harness t/lib/sample-tests/vms_nit Test data for Test::Harness t/lib/sample-tests/with_comments Test data for Test::Harness t/lib/strict/refs Tests of "use strict 'refs'" for strict.t diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index efb9a1f..50de3b5 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -1,5 +1,5 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $Id: Harness.pm,v 1.38 2002/06/19 21:01:01 schwern Exp $ +# $Id: Harness.pm,v 1.43 2003/03/24 20:09:50 andy Exp $ package Test::Harness; @@ -22,7 +22,7 @@ use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest $Have_Devel_Corestack = 0; -$VERSION = '2.26'; +$VERSION = '2.27_02'; $ENV{HARNESS_ACTIVE} = 1; @@ -469,7 +469,7 @@ sub _run_all_tests { failed => \@failed, bonus => $results{bonus}, skipped => $results{skip}, - skip_reason => $Strap->{_skip_reason}, + skip_reason => $results{skip_reason}, skip_all => $Strap->{skip_all}, ml => $ml, ); @@ -482,12 +482,7 @@ sub _run_all_tests { my($estatus, $wstatus) = @results{qw(exit wait)}; - if ($wstatus) { - $failedtests{$tfile} = _dubious_return(\%test, \%tot, - $estatus, $wstatus); - $failedtests{$tfile}{name} = $tfile; - } - elsif ($results{passing}) { + if ($results{passing}) { if ($test{max} and $test{skipped} + $test{bonus}) { my @msg; push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}") @@ -507,10 +502,26 @@ sub _run_all_tests { $tot{good}++; } else { - if ($test{max}) { - if ($test{'next'} <= $test{max}) { - push @{$test{failed}}, $test{'next'}..$test{max}; + # List unrun tests as failures. + if ($test{'next'} <= $test{max}) { + push @{$test{failed}}, $test{'next'}..$test{max}; + } + # List overruns as failures. + else { + my $details = $results{details}; + foreach my $overrun ($test{max}+1..@$details) + { + next unless ref $details->[$overrun-1]; + push @{$test{failed}}, $overrun } + } + + if ($wstatus) { + $failedtests{$tfile} = _dubious_return(\%test, \%tot, + $estatus, $wstatus); + $failedtests{$tfile}{name} = $tfile; + } + elsif($results{seen}) { if (@{$test{failed}}) { my ($txt, $canon) = canonfailed($test{max},$test{skipped}, @{$test{failed}}); @@ -536,7 +547,7 @@ sub _run_all_tests { }; } $tot{bad}++; - } elsif ($test{'next'} == 0) { + } else { print "FAILED before any test output arrived\n"; $tot{bad}++; $failedtests{$tfile} = { canon => '??', @@ -697,10 +708,10 @@ $Handlers{test} = sub { _print_ml("ok $curr/$max"); if( $detail->{type} eq 'skip' ) { - $self->{_skip_reason} = $detail->{reason} - unless defined $self->{_skip_reason}; - $self->{_skip_reason} = 'various reasons' - if $self->{_skip_reason} ne $detail->{reason}; + $totals->{skip_reason} = $detail->{reason} + unless defined $totals->{skip_reason}; + $totals->{skip_reason} = 'various reasons' + if $totals->{skip_reason} ne $detail->{reason}; } } else { @@ -858,12 +869,15 @@ sub _create_fmts { sub corestatus { my($st) = @_; - eval { + my $did_core; + eval { # we may not have a WCOREDUMP local $^W = 0; # *.ph files are often *very* noisy - require 'wait.ph' + require 'wait.ph'; + $did_core = WCOREDUMP($st); }; - return if $@; - my $did_core = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200; + if( $@ ) { + $did_core = $st & 0200; + } eval { require Devel::CoreStack; $Have_Devel_Corestack++ } unless $tried_devel_corestack++; @@ -1058,6 +1072,14 @@ exist. Andreas Koenig held the torch for many years. Current maintainer is Michael G Schwern Eschwern@pobox.comE +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F + + =head1 TODO Provide a way of running tests quietly (ie. no printing) for automated diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes index 892c243..1287d9a 100644 --- a/lib/Test/Harness/Changes +++ b/lib/Test/Harness/Changes @@ -1,5 +1,22 @@ Revision history for Perl extension Test::Harness +2.27_02 Mon Mar 24 13:17:00 CDT 2003 +2.27_01 Sun Mar 23 19:46:00 CDT 2003 + - Handed over to Andy Lester for further maintenance. + - Fixed when the path to perl contains spaces on Windows + * Stas Bekman noticed that tests with no output at all were + interpreted as passing + - MacPerl test tweak for busted exit codes (bleadperl 17345) + - Abigail and Nick Clark both hit the 100000 "huge test that will + suck up all your memory" limit with legit tests. Made the check + smarter to allow large, planned tests to work. + - Partial fix of stats display when a test fails only because there's + too many tests. + - Made wait.ph and WCOREDUMP anti-vommit protection more robust in + cases where wait.ph loads but WCOREDUMP() pukes when run. + - Added a LICENSE. + - Ilya noticed the per test skip reason was accumlating between tests. + 2.26 Wed Jun 19 16:58:02 EDT 2002 - Workaround for MacPerl's lack of a working putenv. It will never see the PERL5LIB environment variable (perl@16942). diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm index 7530045..6ce6b2d 100644 --- a/lib/Test/Harness/Straps.pm +++ b/lib/Test/Harness/Straps.pm @@ -1,5 +1,5 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $Id: Straps.pm,v 1.13 2002/06/19 21:01:04 schwern Exp $ +# $Id: Straps.pm,v 1.16 2003/02/02 05:27:44 schwern Exp $ package Test::Harness::Straps; @@ -93,7 +93,8 @@ Initialize the internal state of a strap to make it ready for parsing. sub _init { my($self) = shift; - $self->{_is_vms} = $^O eq 'VMS'; + $self->{_is_vms} = $^O eq 'VMS'; + $self->{_is_win32} = $^O eq 'Win32'; } =end _private @@ -150,10 +151,10 @@ sub _analyze_iterator { $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all}; - my $passed = !$totals{max} || - ($totals{max} && $totals{seen} && - $totals{max} == $totals{seen} && - $totals{max} == $totals{ok}); + my $passed = ($totals{max} == 0 && defined $totals{skip_all}) || + ($totals{max} && $totals{seen} && + $totals{max} == $totals{seen} && + $totals{max} == $totals{ok}); $totals{passing} = $passed ? 1 : 0; return %totals; @@ -206,7 +207,7 @@ sub _analyze_line { $totals->{ok}++ if $pass; - if( $result{number} > 100000 ) { + if( $result{number} > 100000 && $result{number} > $self->{max} ) { warn "Enormous test number seen [test $result{number}]\n"; warn "Can't detailize, too big.\n"; } @@ -269,8 +270,9 @@ sub analyze_file { local $ENV{PERL5LIB} = $self->_INC2PERL5LIB; - # Is this necessary anymore? - my $cmd = $self->{_is_vms} ? "MCR $^X" : $^X; + my $cmd = $self->{_is_vms} ? "MCR $^X" : + $self->{_is_win32} ? Win32::GetShortPathName($^X) + : $^X; my $switches = $self->_switches($file); @@ -467,7 +469,11 @@ sub _is_header { $self->{todo} = { map { $_ => 1 } split /\s+/, $todo } if $todo; - $self->{skip_all} = $reason if defined $skip and $skip =~ /^Skip/i; + if( $self->{max} == 0 ) { + $reason = '' unless defined $skip and $skip =~ /^Skip/i; + } + + $self->{skip_all} = $reason; } return $YES; diff --git a/lib/Test/Harness/t/strap-analyze.t b/lib/Test/Harness/t/strap-analyze.t index 02fa1d6..b42c875 100644 --- a/lib/Test/Harness/t/strap-analyze.t +++ b/lib/Test/Harness/t/strap-analyze.t @@ -20,11 +20,11 @@ my $SAMPLE_TESTS = $ENV{PERL_CORE} : File::Spec->catdir($Curdir, 't', 'sample-tests'); -my $IsMacOS = $^O eq 'MacOS'; +my $IsMacPerl = $^O eq 'MacOS'; my $IsVMS = $^O eq 'VMS'; # VMS uses native, not POSIX, exit codes. -my $die_exit = $IsVMS ? 44 : $IsMacOS ? 0 : 1; +my $die_exit = $IsVMS ? 44 : 1; # We can only predict that the wait status should be zero or not. my $wait_non_zero = 1; @@ -174,6 +174,23 @@ my %samples = ( ], }, + no_output => { + passing => 0, + + 'exit' => 0, + 'wait' => 0, + + max => 0, + seen => 0, + + 'ok' => 0, + 'todo' => 0, + 'skip' => 0, + bonus => 0, + + details => [], + }, + simple => { passing => 1, @@ -284,6 +301,7 @@ my %samples = ( max => 0, seen => 0, + skip_all => '', 'ok' => 0, 'todo' => 0, @@ -470,7 +488,7 @@ while( my($test, $expect) = each %samples ) { delete $results{details}; SKIP: { - skip '$? unreliable in MacPerl', 2 if $IsMacOS; + 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' ); diff --git a/lib/Test/Harness/t/strap.t b/lib/Test/Harness/t/strap.t index 26af9f3..a69f0c6 100644 --- a/lib/Test/Harness/t/strap.t +++ b/lib/Test/Harness/t/strap.t @@ -12,7 +12,7 @@ BEGIN { use strict; -use Test::More tests => 146; +use Test::More tests => 147; use_ok('Test::Harness::Straps'); @@ -72,7 +72,9 @@ my @attribs = qw(max skip_all todo); my %headers = ( '1..2' => { max => 2 }, '1..1' => { max => 1 }, - '1..0' => { max => 0 }, + '1..0' => { max => 0, + skip_all => '', + }, '1..0 # Skipped: no leverage found' => { max => 0, skip_all => 'no leverage found', }, @@ -84,17 +86,17 @@ my %headers = ( }, '1..10 todo 2 4 10' => { max => 10, 'todo' => { 2 => 1, - 4 => 1, - 10 => 1, + 4 => 1, + 10 => 1, }, }, '1..10 todo' => { max => 10 }, '1..192 todo 4 2 13 192 # Skip skip skip because' => { max => 192, 'todo' => { 4 => 1, - 2 => 1, - 13 => 1, - 192 => 1, + 2 => 1, + 13 => 1, + 192 => 1, }, skip_all => 'skip skip because' } diff --git a/lib/Test/Harness/t/test-harness.t b/lib/Test/Harness/t/test-harness.t index e9f99c8..f8d8c28 100644 --- a/lib/Test/Harness/t/test-harness.t +++ b/lib/Test/Harness/t/test-harness.t @@ -40,11 +40,14 @@ package main; use Test::More; -my $IsMacOS = $^O eq 'MacOS'; +my $IsMacPerl = $^O eq 'MacOS'; my $IsVMS = $^O eq 'VMS'; # VMS uses native, not POSIX, exit codes. -my $die_estat = $IsVMS ? 44 : $IsMacOS ? 0 : 1; +# MacPerl's exit codes are broken. +my $die_estat = $IsVMS ? 44 : + $IsMacPerl ? 0 : + 1; my %samples = ( simple => { @@ -250,6 +253,23 @@ my %samples = ( }, all_ok => 0, }, + no_output => { + total => { + bonus => 0, + max => 0, + 'ok' => 0, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped => 0, + 'todo' => 0, + skipped => 0, + }, + failed => { + }, + all_ok => 0, + }, skipall => { total => { bonus => 0, @@ -414,6 +434,24 @@ my %samples = ( failed => { }, all_ok => 1, }, + too_many => { + total => { + bonus => 0, + max => 3, + 'ok' => 7, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped => 0, + 'todo' => 0, + skipped => 0, + }, + failed => { + canon => '4-7', + }, + all_ok => 0, + }, ); plan tests => (keys(%samples) * 8) + 1; @@ -438,8 +476,8 @@ while (my($test, $expect) = each %samples) { }; select STDOUT; - # $? is unreliable in MacPerl, so we'll simply fudge it. - $failed->{estat} = $die_estat if $IsMacOS and $failed; + # $? is unreliable in MacPerl, so we'll just fudge it. + $failed->{estat} = $die_estat if $IsMacPerl and $failed; SKIP: { skip "special tests for bailout", 1 unless $test eq 'bailout'; diff --git a/t/lib/sample-tests/no_output b/t/lib/sample-tests/no_output new file mode 100644 index 0000000..505acda --- /dev/null +++ b/t/lib/sample-tests/no_output @@ -0,0 +1,3 @@ +#!/usr/bin/perl -w + +exit; diff --git a/t/lib/sample-tests/segfault b/t/lib/sample-tests/segfault new file mode 100644 index 0000000..c5670a4 --- /dev/null +++ b/t/lib/sample-tests/segfault @@ -0,0 +1,5 @@ +#!/usr/bin/perl + +print "1..1\n"; +print "ok 1\n"; +kill 11, $$; diff --git a/t/lib/sample-tests/too_many b/t/lib/sample-tests/too_many new file mode 100644 index 0000000..46acade --- /dev/null +++ b/t/lib/sample-tests/too_many @@ -0,0 +1,14 @@ +print <