From: Michael G. Schwern Date: Fri, 7 Sep 2001 03:30:41 +0000 (-0400) Subject: Test::Harness 1.25 sync X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2fe373ce2a1c176022df002e73eae7d1ec7f2768;p=p5sagit%2Fp5-mst-13.2.git Test::Harness 1.25 sync Message-ID: <20010907033041.A2796@blackrider> p4raw-id: //depot/perl@11931 --- diff --git a/MANIFEST b/MANIFEST index 0e00ff7..a7ba7b1 100644 --- a/MANIFEST +++ b/MANIFEST @@ -104,9 +104,9 @@ ext/ByteLoader/byterun.h Header for byterun.c ext/ByteLoader/hints/sunos.pl Hints for named architecture ext/ByteLoader/Makefile.PL Bytecode loader makefile writer ext/Cwd/Cwd.xs Cwd extension external subroutines +ext/Cwd/Makefile.PL Cwd extension makefile maker ext/Cwd/t/cwd.t See if Cwd works ext/Cwd/t/taint.t See if Cwd works with taint -ext/Cwd/Makefile.PL Cwd extension makefile maker ext/Data/Dumper/Changes Data pretty printer, changelog ext/Data/Dumper/Dumper.pm Data pretty printer, module ext/Data/Dumper/Dumper.xs Data pretty printer, externals @@ -954,10 +954,10 @@ lib/IPC/SysV.t See if IPC::SysV works lib/less.pm For "use less" lib/less.t See if less support works lib/lib_pm.PL For "use lib", produces lib/lib.pm +lib/Lingua/KO/Hangul/Util.pm Lingua::KO::Hangul::Util lib/Lingua/KO/Hangul/Util/Changes Lingua::KO::Hangul::Util lib/Lingua/KO/Hangul/Util/README Lingua::KO::Hangul::Util lib/Lingua/KO/Hangul/Util/t/test.t Lingua::KO::Hangul::Util -lib/Lingua/KO/Hangul/Util.pm Lingua::KO::Hangul::Util lib/locale.pm For "use locale" lib/locale.t See if locale support works lib/Locale/Codes/t/all.t See if Locale::Codes work @@ -1123,17 +1123,20 @@ lib/Term/ReadLine.pm Stub readline library lib/termcap.pl Perl library supporting termcap usage lib/Test.pm A simple framework for writing test scripts lib/Test/Harness.pm A test harness -lib/Test/Harness.t See if Test::Harness works +lib/Test/Harness/Changes Test::Harness +lib/Test/Harness/t/base.t Test::Harness +lib/Test/Harness/t/ok.t Test::Harness +lib/Test/Harness/t/test-harness.t Test::Harness test lib/Test/More.pm More utilities for writing tests lib/Test/Simple.pm Basic utility for writing tests lib/Test/Simple/Changes Test::Simple changes -lib/Test/Simple/t/More.t Test::More test, basic stuff lib/Test/Simple/t/exit.t Test::Simple test, exit codes lib/Test/Simple/t/extra.t Test::Simple test lib/Test/Simple/t/fail-like.t Test::More test, like() failures lib/Test/Simple/t/fail-more.t Test::More test, tests failing lib/Test/Simple/t/fail.t Test::Simple test, test failures lib/Test/Simple/t/missing.t Test::Simple test, missing tests +lib/Test/Simple/t/More.t Test::More test, basic stuff lib/Test/Simple/t/no_plan.t Test::Simple test, forgot the plan lib/Test/Simple/t/plan_is_noplan.t Test::Simple test, no_plan lib/Test/Simple/t/simple.t Test::Simple test, basic stuff @@ -1155,7 +1158,6 @@ lib/Text/Abbrev.t Test Text::Abbrev lib/Text/Balanced.pm Text::Balanced lib/Text/Balanced/Changes Text::Balanced lib/Text/Balanced/README Text::Balanced -lib/Text/Balanced/t/gentag.t See if Text::Balanced works lib/Text/Balanced/t/extbrk.t See if Text::Balanced works lib/Text/Balanced/t/extcbk.t See if Text::Balanced works lib/Text/Balanced/t/extdel.t See if Text::Balanced works @@ -1163,6 +1165,7 @@ lib/Text/Balanced/t/extmul.t See if Text::Balanced works lib/Text/Balanced/t/extqlk.t See if Text::Balanced works lib/Text/Balanced/t/exttag.t See if Text::Balanced works lib/Text/Balanced/t/extvar.t See if Text::Balanced works +lib/Text/Balanced/t/gentag.t See if Text::Balanced works lib/Text/ParseWords.pm Perl module to split words on arbitrary delimiter lib/Text/ParseWords.t See if Text::ParseWords works lib/Text/Soundex.pm Perl module to implement Soundex @@ -1940,22 +1943,25 @@ t/lib/dprof/test6_t Perl code profiler tests t/lib/dprof/test6_v Perl code profiler tests t/lib/dprof/V.pm Perl code profiler tests t/lib/filter-util.pl See if Filter::Util::Call works +t/lib/FilterTest.pm Helper file for lib/Filter/Simple/t/filter.t t/lib/h2ph.h Test header file for h2ph t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison t/lib/locale/latin1 Part of locale.t in Latin 1 t/lib/locale/utf8 Part of locale.t in UTF8 -t/lib/FilterTest.pm Helper file for lib/Filter/Simple/t/filter.t t/lib/sample-tests/bailout Test data for Test::Harness t/lib/sample-tests/combined Test data for Test::Harness t/lib/sample-tests/descriptive Test data for Test::Harness t/lib/sample-tests/duplicates Test data for Test::Harness t/lib/sample-tests/header_at_end Test data for Test::Harness +t/lib/sample-tests/header_at_end_fail Test::Harness t/lib/sample-tests/no_nums 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/skip_all Test data for Test::Harness +t/lib/sample-tests/skip_no_msg Test::Harness t/lib/sample-tests/todo Test data for Test::Harness +t/lib/sample-tests/todo_inline Test::Harness t/lib/sample-tests/with_comments Test data for Test::Harness t/lib/st-dump.pl See if Storable works 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 29344cd..8d97c75 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.11 2001/05/23 18:24:41 schwern Exp $ +# $Id: Harness.pm,v 1.17 2001/09/07 06:20:29 schwern Exp $ package Test::Harness; @@ -20,7 +20,7 @@ use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest $Have_Devel_Corestack = 0; -$VERSION = "1.21"; +$VERSION = 1.25; $ENV{HARNESS_ACTIVE} = 1; @@ -206,11 +206,11 @@ test script, please use a comment. It will happen, your tests will fail. After you mop up your ego, you can begin examining the summary report: - t/base..............ok - t/nonumbers.........ok - t/ok................ok - t/test-harness......ok - t/waterloo..........dubious + t/base..............ok + t/nonumbers.........ok + t/ok................ok + t/test-harness......ok + t/waterloo..........dubious Test returned status 3 (wstat 768, 0x300) DIED. FAILED tests 1, 3, 5, 7, 9, 11, 13, 15, 17, 19 Failed 10/20 tests, 50.00% okay @@ -289,7 +289,7 @@ sub runtests { my($tot, $failedtests) = _run_all_tests(@tests); _show_results($tot, $failedtests); - my $ok = ($tot->{bad} == 0 && $tot->{max}); + my $ok = _all_ok($tot); die q{Assert '$ok xor keys %$failedtests' failed!} unless $ok xor keys %$failedtests; @@ -299,6 +299,20 @@ sub runtests { =begin _private +=item B<_all_ok> + + my $ok = _all_ok(\%tot); + +Tells you if this test run is overall successful or not. + +=cut + +sub _all_ok { + my($tot) = shift; + + return $tot->{bad} == 0 && ($tot->{max} || $tot->{skipped}) ? 1 : 0; +} + =item B<_globdir> my @files = _globdir $dir; @@ -328,6 +342,7 @@ and values are this: max Number of individual tests ran ok Number of individual tests passed sub_skipped Number of individual tests skipped + todo Number of individual todo tests files Number of test files ran good Number of test files passed @@ -371,8 +386,9 @@ sub _run_all_tests { good => 0, tests => scalar @tests, sub_skipped => 0, + todo => 0, skipped => 0, - bench => 0 + bench => 0, ); # pass -I flags to children @@ -383,8 +399,8 @@ sub _run_all_tests { # for VMS my $new5lib; if ($^O eq 'VMS') { - $new5lib = join($Config{path_sep}, grep {!/perl_root/i;} @INC); - $Switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g; + $new5lib = join($Config{path_sep}, grep {!/perl_root/i;} @INC); + $Switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g; } else { $new5lib = join($Config{path_sep}, @INC); @@ -398,14 +414,15 @@ sub _run_all_tests { my $maxlen = 0; my $maxsuflen = 0; foreach (@tests) { # The same code in t/TEST - my $suf = /\.(\w+)$/ ? $1 : ''; - my $len = length; - my $suflen = length $suf; - $maxlen = $len if $len > $maxlen; - $maxsuflen = $suflen if $suflen > $maxsuflen; + my $suf = /\.(\w+)$/ ? $1 : ''; + my $len = length; + my $suflen = length $suf; + $maxlen = $len if $len > $maxlen; + $maxsuflen = $suflen if $suflen > $maxsuflen; } # + 3 : we want three dots between the test name and the "ok" my $width = $maxlen + 3 - $maxsuflen; + foreach my $tfile (@tests) { my($leader, $ml) = _mk_leader($tfile, $width); print $leader; @@ -426,7 +443,7 @@ sub _run_all_tests { ); my($seen_header, $tests_seen) = (0,0); - while (<$fh>) { + while (<$fh>) { if( _parse_header($_, \%test, \%tot) ) { warn "Test header seen twice!\n" if $seen_header; @@ -439,36 +456,36 @@ sub _run_all_tests { $tests_seen++; } # else, ignore it. - } + } my($estatus, $wstatus) = _close_fh($fh); my $allok = $test{ok} == $test{max} && $test{'next'} == $test{max}+1; - if ($wstatus) { + if ($wstatus) { $failedtests{$tfile} = _dubious_return(\%test, \%tot, $estatus, $wstatus); $failedtests{$tfile}{name} = $tfile; - } + } elsif ($allok) { - if ($test{max} and $test{skipped} + $test{bonus}) { - 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}; - print "$test{ml}ok, ".join(', ', @msg)."\n"; - } elsif ($test{max}) { - print "$test{ml}ok\n"; - } elsif (defined $test{skip_reason}) { - print "skipped: $test{skip_reason}\n"; - $tot{skipped}++; - } else { - print "skipped test on this platform\n"; - $tot{skipped}++; - } - $tot{good}++; - } + if ($test{max} and $test{skipped} + $test{bonus}) { + 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}; + print "$test{ml}ok, ".join(', ', @msg)."\n"; + } elsif ($test{max}) { + print "$test{ml}ok\n"; + } elsif (defined $test{skip_reason}) { + print "skipped: $test{skip_reason}\n"; + $tot{skipped}++; + } else { + print "skipped test on this platform\n"; + $tot{skipped}++; + } + $tot{good}++; + } else { if ($test{max}) { if ($test{'next'} <= $test{max}) { @@ -513,28 +530,28 @@ sub _run_all_tests { } } - $tot{sub_skipped} += $test{skipped}; - - if (defined $Files_In_Dir) { - my @new_dir_files = _globdir $Files_In_Dir; - if (@new_dir_files != @dir_files) { - my %f; - @f{@new_dir_files} = (1) x @new_dir_files; - delete @f{@dir_files}; - my @f = sort keys %f; - print "LEAKED FILES: @f\n"; - @dir_files = @new_dir_files; - } - } + $tot{sub_skipped} += $test{skipped}; + + if (defined $Files_In_Dir) { + my @new_dir_files = _globdir $Files_In_Dir; + if (@new_dir_files != @dir_files) { + my %f; + @f{@new_dir_files} = (1) x @new_dir_files; + delete @f{@dir_files}; + my @f = sort keys %f; + print "LEAKED FILES: @f\n"; + @dir_files = @new_dir_files; + } + } } $tot{bench} = timediff(new Benchmark, $t_start); if ($^O eq 'VMS') { - if (defined $old5lib) { - $ENV{PERL5LIB} = $old5lib; - } else { - delete $ENV{PERL5LIB}; - } + if (defined $old5lib) { + $ENV{PERL5LIB} = $old5lib; + } else { + delete $ENV{PERL5LIB}; + } } return(\%tot, \%failedtests); @@ -547,13 +564,15 @@ sub _run_all_tests { Generates the 't/foo........' $leader for the given $test_file as well as a similar version which will overwrite the current line (by use of \r and such). $ml may be empty if Test::Harness doesn't think you're -on TTY. The width is the width of the "yada/blah..." string. +on TTY. + +The $width is the width of the "yada/blah.." string. =cut sub _mk_leader { - my ($te, $width) = @_; - + my($te, $width) = @_; + chomp($te); $te =~ s/\.\w+$/./; if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; } @@ -574,33 +593,34 @@ sub _show_results { my $pct; my $bonusmsg = _bonusmsg($tot); - if ($tot->{bad} == 0 && $tot->{max}) { - print "All tests successful$bonusmsg.\n"; - } elsif ($tot->{tests}==0){ - die "FAILED--no tests were run for some reason.\n"; - } elsif ($tot->{max} == 0) { - my $blurb = $tot->{tests}==1 ? "script" : "scripts"; - die "FAILED--$tot->{tests} test $blurb could be run, ". + if (_all_ok($tot)) { + print "All tests successful$bonusmsg.\n"; + } elsif (!$tot->{tests}){ + die "FAILED--no tests were run for some reason.\n"; + } elsif (!$tot->{max}) { + my $blurb = $tot->{tests}==1 ? "script" : "scripts"; + die "FAILED--$tot->{tests} test $blurb could be run, ". "alas--no output ever seen\n"; } else { - $pct = sprintf("%.2f", $tot->{good} / $tot->{tests} * 100); - my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.", - $tot->{max} - $tot->{ok}, $tot->{max}, - 100*$tot->{ok}/$tot->{max}; + $pct = sprintf("%.2f", $tot->{good} / $tot->{tests} * 100); + my $percent_ok = 100*$tot->{ok}/$tot->{max}; + my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.", + $tot->{max} - $tot->{ok}, $tot->{max}, + $percent_ok; my($fmt_top, $fmt) = _create_fmts($failedtests); - # Now write to formats - for my $script (sort keys %$failedtests) { - $Curtest = $failedtests->{$script}; - write; - } - if ($tot->{bad}) { - $bonusmsg =~ s/^,\s*//; - print "$bonusmsg.\n" if $bonusmsg; - die "Failed $tot->{bad}/$tot->{tests} test scripts, $pct% okay.". + # Now write to formats + for my $script (sort keys %$failedtests) { + $Curtest = $failedtests->{$script}; + write; + } + if ($tot->{bad}) { + $bonusmsg =~ s/^,\s*//; + print "$bonusmsg.\n" if $bonusmsg; + die "Failed $tot->{bad}/$tot->{tests} test scripts, $pct% okay.". "$subpct\n"; - } + } } printf("Files=%d, Tests=%d, %s\n", @@ -656,8 +676,8 @@ sub _open_test { # XXX This is WAY too core specific! my $cmd = ($ENV{'HARNESS_COMPILE_TEST'}) ? "./perl -I../lib ../utils/perlcc $test " - . "-r 2>> ./compilelog |" - : "$^X $s $test|"; + . "-r 2>> ./compilelog |" + : "$^X $s $test|"; $cmd = "MCR $cmd" if $^O eq 'VMS'; if( open(PERL, $cmd) ) { @@ -680,51 +700,54 @@ sub _parse_test_line { my($line, $test, $tot) = @_; if ($line =~ /^(not\s+)?ok\b/i) { - my $this = $test->{'next'} || 1; + $test->{'next'} ||= 1; + my $this = $test->{'next'}; # "not ok 23" - if ($line =~ /^(not )?ok\s*(\d*)(\s*#.*)?/) { - my($not, $tnum, $extra) = ($1, $2, $3); - - $this = $tnum if $tnum; - - my($type, $reason) = $extra =~ /^\s*#\s*([Ss]kip\S*|TODO)(\s+.+)?/ - if defined $extra; - - my($istodo, $isskip); - if( defined $type ) { - $istodo = $type =~ /TODO/; - $isskip = $type =~ /skip/i; - } - - $test->{todo}{$tnum} = 1 if $istodo; - - if( $not ) { - print "$test->{ml}NOK $this" if $test->{ml}; - if (!$test->{todo}{$this}) { - push @{$test->{failed}}, $this; - } else { - $test->{ok}++; - $tot->{ok}++; - } - } - else { - print "$test->{ml}ok $this/$test->{max}" if $test->{ml}; - $test->{ok}++; - $tot->{ok}++; - $test->{skipped}++ if $isskip; - - $reason = '[no reason given]' - if $isskip and not defined $reason; - if (defined $reason and defined $test->{skip_reason}) { - # print "was: '$skip_reason' new '$reason'\n"; - $test->{skip_reason} = 'various reasons' - if $test->{skip_reason} ne $reason; - } elsif (defined $reason) { - $test->{skip_reason} = $reason; - } - - $test->{bonus}++, $tot->{bonus}++ if $test->{todo}{$this}; - } + if ($line =~ /^(not )?ok\s*(\d*)[^#]*(\s*#.*)?/) { + my($not, $tnum, $extra) = ($1, $2, $3); + + $this = $tnum if $tnum; + + my($type, $reason) = $extra =~ /^\s*#\s*([Ss]kip\S*|TODO)(\s+.+)?/ + if defined $extra; + + my($istodo, $isskip); + if( defined $type ) { + $istodo = 1 if $type =~ /TODO/; + $isskip = 1 if $type =~ /skip/i; + } + + $test->{todo}{$this} = 1 if $istodo; + + $tot->{todo}++ if $test->{todo}{$this}; + + if( $not ) { + print "$test->{ml}NOK $this" if $test->{ml}; + if (!$test->{todo}{$this}) { + push @{$test->{failed}}, $this; + } else { + $test->{ok}++; + $tot->{ok}++; + } + } + else { + print "$test->{ml}ok $this/$test->{max}" if $test->{ml}; + $test->{ok}++; + $tot->{ok}++; + $test->{skipped}++ if $isskip; + + $reason = '[no reason given]' + if $isskip and not defined $reason; + if (defined $reason and defined $test->{skip_reason}) { + # print "was: '$skip_reason' new '$reason'\n"; + $test->{skip_reason} = 'various reasons' + if $test->{skip_reason} ne $reason; + } elsif (defined $reason) { + $test->{skip_reason} = $reason; + } + + $test->{bonus}++, $tot->{bonus}++ if $test->{todo}{$this}; + } } # XXX ummm... dunno elsif ($line =~ /^ok\s*(\d*)\s*\#([^\r]*)$/) { # XXX multiline ok? @@ -740,8 +763,7 @@ sub _parse_test_line { } if ($this > $test->{'next'}) { - # print "Test output counter mismatch [test $this]\n"; - # no need to warn probably + print "Test output counter mismatch [test $this]\n"; push @{$test->{failed}}, $test->{'next'}..$this-1; } elsif ($this < $test->{'next'}) { @@ -765,22 +787,22 @@ sub _bonusmsg { my $bonusmsg = ''; $bonusmsg = (" ($tot->{bonus} subtest".($tot->{bonus} > 1 ? 's' : ''). - " UNEXPECTEDLY SUCCEEDED)") - if $tot->{bonus}; + " UNEXPECTEDLY SUCCEEDED)") + if $tot->{bonus}; if ($tot->{skipped}) { - $bonusmsg .= ", $tot->{skipped} test" + $bonusmsg .= ", $tot->{skipped} test" . ($tot->{skipped} != 1 ? 's' : ''); - if ($tot->{sub_skipped}) { - $bonusmsg .= " and $tot->{sub_skipped} subtest" - . ($tot->{sub_skipped} != 1 ? 's' : ''); - } - $bonusmsg .= ' skipped'; + if ($tot->{sub_skipped}) { + $bonusmsg .= " and $tot->{sub_skipped} subtest" + . ($tot->{sub_skipped} != 1 ? 's' : ''); + } + $bonusmsg .= ' skipped'; } elsif ($tot->{sub_skipped}) { - $bonusmsg .= ", $tot->{sub_skipped} subtest" - . ($tot->{sub_skipped} != 1 ? 's' : '') - . " skipped"; + $bonusmsg .= ", $tot->{sub_skipped} subtest" + . ($tot->{sub_skipped} != 1 ? 's' : '') + . " skipped"; } return $bonusmsg; @@ -792,7 +814,7 @@ sub _close_fh { close($fh); # must close to reap child resource values - my $wstatus = $Ignore_Exitcode ? 0 : $?; # Can trust $? ? + my $wstatus = $Ignore_Exitcode ? 0 : $?; # Can trust $? ? my $estatus; $estatus = ($^O eq 'VMS' ? eval 'use vmsish "status"; $estatus = $?' @@ -845,7 +867,7 @@ sub _dubious_return { if ($test->{'next'} == $test->{max} + 1 and not @{$test->{failed}}) { print "\tafter all the subtests completed successfully\n"; $percent = 0; - $failed = 0; # But we do not set $canon! + $failed = 0; # But we do not set $canon! } else { push @{$test->{failed}}, $test->{'next'}..$test->{max}; @@ -897,23 +919,23 @@ sub _create_fmts { my $fmt_top = "format STDOUT_TOP =\n" . sprintf("%-${max_namelen}s", $failed_str) . $middle_str - . $list_str . "\n" - . "-" x $Columns - . "\n.\n"; + . $list_str . "\n" + . "-" x $Columns + . "\n.\n"; my $fmt = "format STDOUT =\n" - . "@" . "<" x ($max_namelen - 1) + . "@" . "<" x ($max_namelen - 1) . " @>> @>>>> @>>>> @>>> ^##.##% " - . "^" . "<" x ($list_len - 1) . "\n" - . '{ $Curtest->{name}, $Curtest->{estat},' - . ' $Curtest->{wstat}, $Curtest->{max},' - . ' $Curtest->{failed}, $Curtest->{percent},' - . ' $Curtest->{canon}' - . "\n}\n" - . "~~" . " " x ($Columns - $list_len - 2) . "^" - . "<" x ($list_len - 1) . "\n" - . '$Curtest->{canon}' - . "\n.\n"; + . "^" . "<" x ($list_len - 1) . "\n" + . '{ $Curtest->{name}, $Curtest->{estat},' + . ' $Curtest->{wstat}, $Curtest->{max},' + . ' $Curtest->{failed}, $Curtest->{percent},' + . ' $Curtest->{canon}' + . "\n}\n" + . "~~" . " " x ($Columns - $list_len - 2) . "^" + . "<" x ($list_len - 1) . "\n" + . '$Curtest->{canon}' + . "\n.\n"; eval $fmt_top; die $@ if $@; @@ -950,23 +972,23 @@ sub canonfailed ($@) { my $last = $min = shift @failed; my $canon; if (@failed) { - for (@failed, $failed[-1]) { # don't forget the last one - if ($_ > $last+1 || $_ == $last) { - if ($min == $last) { - push @canon, $last; - } else { - push @canon, "$min-$last"; - } - $min = $_; - } - $last = $_; - } - local $" = ", "; - push @result, "FAILED tests @canon\n"; - $canon = join ' ', @canon; + for (@failed, $failed[-1]) { # don't forget the last one + if ($_ > $last+1 || $_ == $last) { + if ($min == $last) { + push @canon, $last; + } else { + push @canon, "$min-$last"; + } + $min = $_; + } + $last = $_; + } + local $" = ", "; + push @result, "FAILED tests @canon\n"; + $canon = join ' ', @canon; } else { - push @result, "FAILED test $last\n"; - $canon = $last; + push @result, "FAILED test $last\n"; + $canon = $last; } push @result, "\tFailed $failed/$max tests, "; diff --git a/lib/Test/Harness.t b/lib/Test/Harness.t deleted file mode 100644 index a4c423d..0000000 --- a/lib/Test/Harness.t +++ /dev/null @@ -1,205 +0,0 @@ -#!perl - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -use strict; - -# For shutting up Test::Harness. -package My::Dev::Null; -use Tie::Handle; -@My::Dev::Null::ISA = qw(Tie::StdHandle); - -sub WRITE { } - - -package main; - -# Utility testing functions. -my $test_num = 1; -sub ok ($;$) { - my($test, $name) = @_; - my $okstring = ''; - $okstring = "not " unless $test; - $okstring .= "ok $test_num"; - $okstring .= " - $name" if defined $name; - print "$okstring\n"; - $test_num++; -} - -sub eqhash { - my($a1, $a2) = @_; - return 0 unless keys %$a1 == keys %$a2; - - my $ok = 1; - foreach my $k (keys %$a1) { - $ok = $a1->{$k} eq $a2->{$k}; - last unless $ok; - } - - return $ok; -} - -use vars qw($Total_tests %samples); - -my $loaded; -BEGIN { $| = 1; $^W = 1; } -END {print "not ok $test_num\n" unless $loaded;} -print "1..$Total_tests\n"; -use Test::Harness; -$loaded = 1; -ok(1, 'compile'); -######################### End of black magic. - -BEGIN { - %samples = ( - simple => { - bonus => 0, - max => 5, - 'ok' => 5, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - skipped => 0, - }, - simple_fail => { - bonus => 0, - max => 5, - 'ok' => 3, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped => 0, - skipped => 0, - }, - descriptive => { - bonus => 0, - max => 5, - 'ok' => 5, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - skipped => 0, - }, - no_nums => { - bonus => 0, - max => 5, - 'ok' => 4, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 0, - skipped => 0, - }, - todo => { - bonus => 1, - max => 5, - 'ok' => 5, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - skipped => 0, - }, - skip => { - bonus => 0, - max => 5, - 'ok' => 5, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 1, - skipped => 0, - }, - bailout => 0, - combined => { - bonus => 1, - max => 10, - 'ok' => 8, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 1, - skipped => 0 - }, - duplicates => { - bonus => 0, - max => 10, - 'ok' => 11, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 0, - skipped => 0, - }, - header_at_end => { - bonus => 0, - max => 4, - 'ok' => 4, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - skipped => 0, - }, - skip_all => { - bonus => 0, - max => 0, - 'ok' => 0, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - skipped => 1, - }, - with_comments => { - bonus => 2, - max => 5, - 'ok' => 5, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - skipped => 0, - }, - ); - - $Total_tests = keys(%samples) + 1; -} - -tie *NULL, 'My::Dev::Null' or die $!; - -while (my($test, $expect) = each %samples) { - # _run_all_tests() runs the tests but skips the formatting. - my($totals, $failed); - eval { - select NULL; # _run_all_tests() isn't as quiet as it should be. - ($totals, $failed) = - Test::Harness::_run_all_tests("lib/sample-tests/$test"); - }; - select STDOUT; - - unless( $@ ) { - ok( eqhash( $expect, {map { $_=>$totals->{$_} } keys %$expect} ), - $test ); - } - else { # special case for bailout - ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i), - $test ); - } -} diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes new file mode 100644 index 0000000..57a9572 --- /dev/null +++ b/lib/Test/Harness/Changes @@ -0,0 +1,79 @@ +Revision history for Perl extension Test::Harness + +1.25 Tue Aug 7 08:51:09 EDT 2001 + * Fixed a bug with tests failing if they're all skipped + reported by Stas Bekman. + - Fixed a very minor warning in 5.004_04 + - Fixed displaying filenames not from @ARGV + - Merging with bleadperl + - minor fixes to the filename in the report + - '[no reason given]' skip reason + +1.24 2001/08/07 12:52:47 *UNRELEASED* + - Added internal information about number of todo tests + +1.23 Tue Jul 31 15:06:47 EDT 2001 + - Merged in Ilya's "various reasons" patch + * Fixed "not ok 23 - some name # TODO" style tests + +1.22 Mon Jun 25 02:00:02 EDT 2001 + * Fixed bug with failing tests using header at end. + - Documented how Test::Harness deals with garbage input + - Turned on test counter mismatch warning + +1.21 Wed May 23 19:22:53 BST 2001 + * No longer considered unstable. Merging back with the perl core. + - Fixed minor nit about the report summary + - Added docs on the meaning of the failure report + - Minor POD nits fixed mirroring perl change 9176 + - TODO and SEE ALSO expanded + +1.20 Wed Mar 14 23:09:20 GMT 2001 by Michael G Schwern *UNSTABLE* + * Fixed and tested with 5.004! + - Added EXAMPLE docs + - Added TODO docs + - Now uneffected by -l, $\ or $, + +1.19 Sat Mar 10 00:43:29 GMT 2001 by Michael G Schwern *UNSTABLE* + - More internal reworking + * Removed use of experimental /(?>...)/ feature for backwards compat + * Removed use of open(my $fh, $file) for backwards compatibility + * Removed use of Tie::StdHandle in tests for backwards compat + * Added dire warning that this is unstable. + - Added some tests from the old CPAN release + +1.18 Mon Mar 5 17:35:11 GMT 2001 by Michael G Schwern + * Under new management! + * Test::Harness is now being concurrently shipped on CPAN as well + as in the core. + - Switched "our" for "use vars" and moved the minimum version back + to 5.004. This may be optimistic. + + +*** Missing version history to be extracted from Perl changes *** + + +1.07 Fri Feb 23 1996 by Andreas Koenig + - Gisle sent me a documentation patch that showed me, that the + unless(/^#/) is unnessessary. Applied the patch and deleted the block + checking for "comment" lines. -- All lines are comment lines that do + not match /^1\.\.([0-9]+)/ or /^(not\s+)?ok\b/. + - Ilyaz request to print "ok (empty test case)" whenever we say 1..0 + implemented. + - Harness now doesn't abort anymore if we received confused test output, + just warns instead. + +1.05 Wed Jan 31 1996 by Andreas Koenig + - More updates on docu and introduced the liberality that the script + output may omit the test numbers. + +1.03 Mon January 28 1996 by Andreas Koenig + - Added the statistics for subtests. Updated the documentation. + +1.02 by Andreas Koenig + - This version reports a list of the tests that failed accompanied by + some trivial statistics. The older (unnumbered) version stopped + processing after the first failed test. + - Additionally it reports the exit status if there is one. + + diff --git a/lib/Test/Harness/t/base.t b/lib/Test/Harness/t/base.t new file mode 100644 index 0000000..a10eb13 --- /dev/null +++ b/lib/Test/Harness/t/base.t @@ -0,0 +1,12 @@ +print "1..1\n"; + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +unless (eval 'require Test::Harness') { + print "not ok 1\n"; +} else { + print "ok 1\n"; +} diff --git a/lib/Test/Harness/t/ok.t b/lib/Test/Harness/t/ok.t new file mode 100644 index 0000000..a10938f --- /dev/null +++ b/lib/Test/Harness/t/ok.t @@ -0,0 +1,8 @@ +-f "core" and unlink "core"; +print <{$k} eq $a2->{$k}; + last unless $ok; + } + + return $ok; +} + +use vars qw($Total_tests %samples); + +my $loaded; +BEGIN { $| = 1; $^W = 1; } +END {print "not ok $test_num\n" unless $loaded;} +print "1..$Total_tests\n"; +use Test::Harness; +$loaded = 1; +ok(1, 'compile'); +######################### End of black magic. + +BEGIN { + %samples = ( + simple => { + total => { + bonus => 0, + max => 5, + 'ok' => 5, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + todo => 0, + skipped => 0, + }, + failed => { }, + all_ok => 1, + }, + simple_fail => { + total => { + bonus => 0, + max => 5, + 'ok' => 3, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped => 0, + todo => 0, + skipped => 0, + }, + failed => { + canon => '2 5', + }, + all_ok => 0, + }, + descriptive => { + total => { + bonus => 0, + max => 5, + 'ok' => 5, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + todo => 0, + skipped => 0, + }, + failed => { }, + all_ok => 1, + }, + no_nums => { + total => { + bonus => 0, + max => 5, + 'ok' => 4, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + todo => 0, + skipped => 0, + }, + failed => { + canon => '3', + }, + all_ok => 0, + }, + todo => { + total => { + bonus => 1, + max => 5, + 'ok' => 5, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + todo => 2, + skipped => 0, + }, + failed => { }, + all_ok => 1, + }, + todo_inline => { + total => { + bonus => 1, + max => 3, + 'ok' => 3, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped => 0, + todo => 2, + skipped => 0, + }, + failed => { }, + all_ok => 1, + }, + skip => { + total => { + bonus => 0, + max => 5, + 'ok' => 5, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 1, + todo => 0, + skipped => 0, + }, + failed => { }, + all_ok => 1, + }, + bailout => 0, + combined => { + total => { + bonus => 1, + max => 10, + 'ok' => 8, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 1, + todo => 2, + skipped => 0 + }, + failed => { + canon => '3 9', + }, + all_ok => 0, + }, + duplicates => { + total => { + bonus => 0, + max => 10, + 'ok' => 11, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + todo => 0, + skipped => 0, + }, + failed => { + canon => '??', + }, + all_ok => 0, + }, + header_at_end => { + total => { + bonus => 0, + max => 4, + 'ok' => 4, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + todo => 0, + skipped => 0, + }, + failed => { }, + all_ok => 1, + }, + header_at_end_fail=> { + total => { + bonus => 0, + max => 4, + 'ok' => 3, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + todo => 0, + skipped => 0, + }, + failed => { + canon => '2', + }, + all_ok => 0, + }, + skip_all => { + total => { + bonus => 0, + max => 0, + 'ok' => 0, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + todo => 0, + skipped => 1, + }, + failed => { }, + all_ok => 1, + }, + with_comments => { + total => { + bonus => 2, + max => 5, + 'ok' => 5, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + todo => 4, + skipped => 0, + }, + failed => { }, + all_ok => 1, + }, + ); + + $Total_tests = (keys(%samples) * 4); +} + +tie *NULL, 'My::Dev::Null' or die $!; + +while (my($test, $expect) = each %samples) { + # _run_all_tests() runs the tests but skips the formatting. + my($totals, $failed); + eval { + select NULL; # _run_all_tests() isn't as quiet as it should be. + ($totals, $failed) = + Test::Harness::_run_all_tests("lib/sample-tests/$test"); + }; + select STDOUT; + + unless( $@ ) { + ok( Test::Harness::_all_ok($totals) == $expect->{all_ok}, + "$test - all ok" ); + ok( defined $expect->{total}, "$test - has total" ); + ok( eqhash( $expect->{total}, + {map { $_=>$totals->{$_} } keys %{$expect->{total}}} ), + "$test - totals" ); + ok( eqhash( $expect->{failed}, + {map { $_=>$failed->{"lib/sample-tests/$test"}{$_} } + keys %{$expect->{failed}}} ), + "$test - failed" ); + } + else { # special case for bailout + ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i), + $test ); + ok( 1, 'skipping for bailout' ); + ok( 1, 'skipping for bailout' ); + } +} +#!perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use strict; + +# For shutting up Test::Harness. +package My::Dev::Null; +use Tie::Handle; +@My::Dev::Null::ISA = qw(Tie::StdHandle); + +sub WRITE { } + + +package main; + +# Utility testing functions. +my $test_num = 1; +sub ok ($;$) { + my($test, $name) = @_; + my $okstring = ''; + $okstring = "not " unless $test; + $okstring .= "ok $test_num"; + $okstring .= " - $name" if defined $name; + print "$okstring\n"; + $test_num++; +} + +sub eqhash { + my($a1, $a2) = @_; + return 0 unless keys %$a1 == keys %$a2; + + my $ok = 1; + foreach my $k (keys %$a1) { + $ok = $a1->{$k} eq $a2->{$k}; + last unless $ok; + } + + return $ok; +} + +use vars qw($Total_tests %samples); + +my $loaded; +BEGIN { $| = 1; $^W = 1; } +END {print "not ok $test_num\n" unless $loaded;} +print "1..$Total_tests\n"; +use Test::Harness; +$loaded = 1; +ok(1, 'compile'); +######################### End of black magic. + +BEGIN { + %samples = ( + simple => { + bonus => 0, + max => 5, + 'ok' => 5, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + skipped => 0, + }, + simple_fail => { + bonus => 0, + max => 5, + 'ok' => 3, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped => 0, + skipped => 0, + }, + descriptive => { + bonus => 0, + max => 5, + 'ok' => 5, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + skipped => 0, + }, + no_nums => { + bonus => 0, + max => 5, + 'ok' => 4, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + skipped => 0, + }, + todo => { + bonus => 1, + max => 5, + 'ok' => 5, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + skipped => 0, + }, + skip => { + bonus => 0, + max => 5, + 'ok' => 5, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 1, + skipped => 0, + }, + bailout => 0, + combined => { + bonus => 1, + max => 10, + 'ok' => 8, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 1, + skipped => 0 + }, + duplicates => { + bonus => 0, + max => 10, + 'ok' => 11, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + skipped => 0, + }, + header_at_end => { + bonus => 0, + max => 4, + 'ok' => 4, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + skipped => 0, + }, + skip_all => { + bonus => 0, + max => 0, + 'ok' => 0, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + skipped => 1, + }, + with_comments => { + bonus => 2, + max => 5, + 'ok' => 5, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + skipped => 0, + }, + ); + + $Total_tests = keys(%samples) + 1; +} + +tie *NULL, 'My::Dev::Null' or die $!; + +while (my($test, $expect) = each %samples) { + # _run_all_tests() runs the tests but skips the formatting. + my($totals, $failed); + eval { + select NULL; # _run_all_tests() isn't as quiet as it should be. + ($totals, $failed) = + Test::Harness::_run_all_tests("lib/sample-tests/$test"); + }; + select STDOUT; + + unless( $@ ) { + ok( eqhash( $expect, {map { $_=>$totals->{$_} } keys %$expect} ), + $test ); + } + else { # special case for bailout + ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i), + $test ); + } +} diff --git a/t/TEST b/t/TEST index 64da39c..fa945cd 100755 --- a/t/TEST +++ b/t/TEST @@ -226,7 +226,7 @@ EOT $ok = 1; } else { - if (/^(not )?ok (\d+)(\s*#.*)?/ && + if (/^(not )?ok (\d+)[^#]*(\s*#.*)?/ && $2 == $next) { my($not, $num, $extra) = ($1, $2, $3); diff --git a/t/lib/sample-tests/header_at_end_fail b/t/lib/sample-tests/header_at_end_fail new file mode 100644 index 0000000..9d1667a --- /dev/null +++ b/t/lib/sample-tests/header_at_end_fail @@ -0,0 +1,11 @@ +print <