From: Michael G. Schwern Date: Thu, 25 Apr 2002 01:51:27 +0000 (-0400) Subject: Test::Harness 2.01 -> 2.03 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=356733dafb64c27d060c217f81fd00dc55b1e995;p=p5sagit%2Fp5-mst-13.2.git Test::Harness 2.01 -> 2.03 Message-ID: <20020425055127.GB3456@blackrider> p4raw-id: //depot/perl@16155 --- diff --git a/MANIFEST b/MANIFEST index f48cccf..b9a3c83 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2343,8 +2343,12 @@ t/lib/Math/BigInt/BareCalc.pm Bigint's simulation of Calc t/lib/Math/BigInt/Subclass.pm Empty subclass of BigInt for test t/lib/Math/BigRat/Test.pm Math::BigRat test helper t/lib/sample-tests/bailout Test data for Test::Harness +t/lib/sample-tests/bignum 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/die Test data for Test::Harness +t/lib/sample-tests/die_head_end Test data for Test::Harness +t/lib/sample-tests/die_last_minute Test data for Test::Harness t/lib/sample-tests/duplicates Test data for Test::Harness t/lib/sample-tests/head_end Test data for Test::Harness t/lib/sample-tests/head_fail Test data for Test::Harness diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 23e7ed89a..788042a 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.14.2.13 2002/01/07 22:34:32 schwern Exp $ +# $Id: Harness.pm,v 1.14.2.18 2002/04/25 05:04:35 schwern Exp $ package Test::Harness; @@ -22,7 +22,7 @@ use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest $Have_Devel_Corestack = 0; -$VERSION = '2.01'; +$VERSION = '2.03'; $ENV{HARNESS_ACTIVE} = 1; @@ -36,16 +36,13 @@ my $Ignore_Exitcode = $ENV{HARNESS_IGNORE_EXITCODE}; my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR}; -my $Running_In_Perl_Tree = 0; -++$Running_In_Perl_Tree if -d "../t" and -f "../sv.c"; - my $Strap = Test::Harness::Straps->new; @ISA = ('Exporter'); @EXPORT = qw(&runtests); @EXPORT_OK = qw($verbose $switches); -$Verbose = 0; +$Verbose = $ENV{HARNESS_VERBOSE} || 0; $Switches = "-w"; $Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80; $Columns--; # Some shells have trouble with a full line of text. @@ -90,15 +87,16 @@ test program. =item B<'1..M'> -This header tells how many tests there will be. It should be the -first line output by your test program (but it is okay if it is preceded -by comments). +This header tells how many tests there will be. For example, C<1..10> +means you plan on running 10 tests. This is a safeguard in case your +test dies quietly in the middle of its run. + +It should be the first non-comment line output by your test program. -In certain instanced, you may not know how many tests you will -ultimately be running. In this case, it is permitted (but not -encouraged) for the 1..M header to appear as the B line output -by your test (again, it can be followed by further comments). But we -strongly encourage you to put it first. +In certain instances, you may not know how many tests you will +ultimately be running. In this case, it is permitted for the 1..M +header to appear as the B line output by your test (again, it +can be followed by further comments). Under B circumstances should 1..M appear in the middle of your output or more than once. @@ -152,7 +150,7 @@ variations in spacing and case) after C or C, it is counted as a skipped test. If the whole testscript succeeds, the count of skipped tests is included in the generated output. C reports the text after C< # Skip\S*\s+> as a reason -for skipping. +for skipping. ok 23 # skip Insufficient flogiston pressure. @@ -457,6 +455,8 @@ sub _run_all_tests { my $fh = _open_test($tfile); + $tot{files}++; + # state of the current test. my %test = ( ok => 0, @@ -602,11 +602,7 @@ sub _mk_leader { chomp($te); $te =~ s/\.\w+$/./; - if ($^O eq 'VMS') { - $te =~ s/^.*\.t\./\[.t./s; - } - $te =~ s,\\,/,g if $^O eq 'MSWin32'; - $te =~ s,^\.\./,/, if $Running_In_Perl_Tree; + if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; } my $blank = (' ' x 77); my $leader = "$te" . '.' x ($width - length($te)); my $ml = ""; @@ -632,15 +628,12 @@ sub _leader_width { foreach (@_) { my $suf = /\.(\w+)$/ ? $1 : ''; my $len = length; - $len -= 2 if $Running_In_Perl_Tree and m{^\.\.[/\\]}; my $suflen = length $suf; $maxlen = $len if $len > $maxlen; $maxsuflen = $suflen if $suflen > $maxsuflen; } - # we want three dots between the test name and the "ok" for - # typical lengths, and just two dots if longer than 30 characters - $maxlen -= $maxsuflen; - return $maxlen + ($maxlen >= 30 ? 2 : 3); + # + 3 : we want three dots between the test name and the "ok" + return $maxlen + 3 - $maxsuflen; } @@ -703,7 +696,6 @@ sub _parse_header { $tot->{max} += $test->{max}; - $tot->{files}++; } else { $is_header = 0; @@ -718,11 +710,13 @@ sub _open_test { my $s = _set_switches($test); + my $perl = -x $^X ? $^X : $Config{perlpath}; + # 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|"; + : "$perl $s $test|"; $cmd = "MCR $cmd" if $^O eq 'VMS'; if( open(PERL, $cmd) ) { @@ -756,17 +750,14 @@ sub _parse_test_line { } $test->{todo}{$this} = 1 if $istodo; + if( $test->{todo}{$this} ) { + $tot->{todo}++; + $test->{bonus}++, $tot->{bonus}++ unless $not; + } - $tot->{todo}++ if $test->{todo}{$this}; - - if( $not ) { + if( $not && !$test->{todo}{$this} ) { print "$test->{ml}NOK $this" if $test->{ml}; - if (!$test->{todo}{$this}) { - push @{$test->{failed}}, $this; - } else { - $test->{ok}++; - $tot->{ok}++; - } + push @{$test->{failed}}, $this; } else { print "$test->{ml}ok $this/$test->{max}" if $test->{ml}; @@ -783,13 +774,18 @@ sub _parse_test_line { } elsif (defined $reason) { $test->{skip_reason} = $reason; } - - $test->{bonus}++, $tot->{bonus}++ if $test->{todo}{$this}; } if ($this > $test->{'next'}) { print "Test output counter mismatch [test $this]\n"; - push @{$test->{failed}}, $test->{'next'}..$this-1; + + # Guard against resource starvation. + if( $this > 100000 ) { + print "Enourmous test number seen [test $this]\n"; + } + else { + push @{$test->{failed}}, $test->{'next'}..$this-1; + } } elsif ($this < $test->{'next'}) { #we have seen more "ok" lines than the number suggests @@ -971,13 +967,17 @@ sub _create_fmts { sub corestatus { my($st) = @_; - eval {require 'wait.ph'}; - my $ret = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200; + eval { + local $^W = 0; # *.ph files are often *very* noisy + require 'wait.ph' + }; + return if $@; + my $did_core = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200; eval { require Devel::CoreStack; $Have_Devel_Corestack++ } unless $tried_devel_corestack++; - $ret; + return $did_core; } } @@ -1079,17 +1079,18 @@ the script dies with this message. =over 4 -=item C +=item C -Makes harness ignore the exit status of child processes when defined. +Harness sets this before executing the individual tests. This allows +the tests to determine if they are being executed through the harness +or by any other means. -=item C +=item C -When set to a true value, forces it to behave as though STDOUT were -not a console. You may need to set this if you don't want harness to -output more frequent progress messages using carriage returns. Some -consoles may not handle carriage returns properly (which results in a -somewhat messy output). +This value will be used for the width of the terminal. If it is not +set then it will default to C. If this is not set, it will +default to 80. Note that users of Bourne-sh based shells will need to +C for this module to use that variable. =item C @@ -1110,24 +1111,28 @@ If relative, directory name is with respect to the current directory at the moment runtests() was called. Putting absolute path into C may give more predictable results. +=item C + +Makes harness ignore the exit status of child processes when defined. + +=item C + +When set to a true value, forces it to behave as though STDOUT were +not a console. You may need to set this if you don't want harness to +output more frequent progress messages using carriage returns. Some +consoles may not handle carriage returns properly (which results in a +somewhat messy output). + =item C Its value will be prepended to the switches used to invoke perl on each test. For example, setting C to C<-W> will run all tests with all warnings enabled. -=item C +=item C -This value will be used for the width of the terminal. If it is not -set then it will default to C. If this is not set, it will -default to 80. Note that users of Bourne-sh based shells will need to -C for this module to use that variable. - -=item C - -Harness sets this before executing the individual tests. This allows -the tests to determine if they are being executed through the harness -or by any other means. +If true, Test::Harness will output the verbose results of running +its tests. Setting $Test::Harness::verbose will override this. =back @@ -1167,7 +1172,7 @@ Current maintainer is Michael G Schwern Eschwern@pobox.comE Provide a way of running tests quietly (ie. no printing) for automated validation of tests. This will probably take the form of a version of runtests() which rather than printing its output returns raw data -on the state of the tests. +on the state of the tests. (Partially done in Test::Harness::Straps) Fix HARNESS_COMPILE_TEST without breaking its core usage. @@ -1175,8 +1180,6 @@ Figure a way to report test names in the failure summary. Rework the test summary so long test names are not truncated as badly. -Merge back into bleadperl. - Deal with VMS's "not \nok 4\n" mistake. Add option for coverage analysis. @@ -1189,13 +1192,7 @@ Clean up how the summary is printed. Get rid of those damned formats. =head1 BUGS -Test::Harness uses $^X to determine the perl binary to run the tests -with. Test scripts running via the shebang (C<#!>) line may not be -portable because $^X is not consistent for shebang scripts across -platforms. This is no problem when Test::Harness is run with an -absolute path to the perl binary or when $^X can be found in the path. - -HARNESS_COMPILE_TEST currently assumes it is run from the Perl source +HARNESS_COMPILE_TEST currently assumes it's run from the Perl source directory. =cut diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes index fcd8bb2..7ba77b1 100644 --- a/lib/Test/Harness/Changes +++ b/lib/Test/Harness/Changes @@ -1,5 +1,24 @@ Revision history for Perl extension Test::Harness +2.03 Thu Apr 25 01:01:34 EDT 2002 + * $^X fix made safer. + - Noise from loading wait.ph to analyze core files supressed + - MJD found a situation where a test could run Test::Harness + out of memory. Protecting against that specific case. + - Made the 1..M docs a bit clearer. + - Fixed TODO tests so Test::Harness does not display a NOK for + them. + - Test::Harness::Straps->analyze_file() docs were not clear as to + its effects + +2.02 Thu Mar 14 18:06:04 EST 2002 + * Ken Williams fixed the long standing $^X bug. + * Added HARNESS_VERBOSE + * Fixed a bug where Test::Harness::Straps was considering a test that + is ok but died as passing. + - Added the exit and wait codes of the test to the + analyze_file() results. + 2.01 Thu Dec 27 18:54:36 EST 2001 * Added 'passing' to the results to tell you if the test passed * Added Test::Harness::Straps example (examples/mini_harness.plx) diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm index 27f46bf..481637b 100644 --- a/lib/Test/Harness/Straps.pm +++ b/lib/Test/Harness/Straps.pm @@ -1,12 +1,12 @@ # -*- Mode: cperl; cperl-indent-level: 4 -*- -# $Id: Straps.pm,v 1.1.2.17 2002/01/07 22:34:33 schwern Exp $ +# $Id: Straps.pm,v 1.1.2.20 2002/04/25 05:04:35 schwern Exp $ package Test::Harness::Straps; use strict; use vars qw($VERSION); use Config; -$VERSION = '0.08'; +$VERSION = '0.09'; use Test::Harness::Assert; use Test::Harness::Iterator; @@ -147,13 +147,14 @@ sub _analyze_iterator { last if $self->{saw_bailout}; } + $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all}; + my $passed = $totals{skip_all} || - ($totals{max} == $totals{seen} && + ($totals{max} && $totals{seen} && + $totals{max} == $totals{seen} && $totals{max} == $totals{ok}); $totals{passing} = $passed ? 1 : 0; - $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all}; - $self->{totals}{$name} = \%totals; return %totals; } @@ -205,8 +206,14 @@ sub _analyze_line { $totals->{ok}++ if $pass; - $totals->{details}[$result{number} - 1] = + if( $result{number} > 100000 ) { + warn "Enourmous test number seen [test $result{number}]\n"; + warn "Can't detailize, too big.\n"; + } + else { + $totals->{details}[$result{number} - 1] = {$self->_detailize($pass, \%result)}; + } # XXX handle counter mismatch } @@ -242,8 +249,8 @@ sub analyze_fh { my %results = $strap->analyze_file($test_file); -Like C, but it reads from the given $test_file. It will also -use that name for the total report. +Like C, but it runs the given $test_file and parses it's +results. It will also use that name for the total report. =cut @@ -264,7 +271,10 @@ sub analyze_file { } my %results = $self->analyze_fh($file, \*FILE); - close FILE; + my $exit = close FILE; + $results{'wait'} = $?; + $results{'exit'} = $? / 256; + $results{passing} = 0 unless $? == 0; $self->_restore_PERL5LIB(); @@ -558,6 +568,9 @@ The %results returned from analyze() contain the following information: passing true if the whole test is considered a pass (or skipped), false if its a failure + exit the exit code of the test run, if from a file + wait the wait code of the test run, if from a file + max total tests which should have been run seen total tests actually seen skip_all if the whole test was skipped, this will diff --git a/lib/Test/Harness/t/strap-analyze.t b/lib/Test/Harness/t/strap-analyze.t index 06addd6..3a5c64f 100644 --- a/lib/Test/Harness/t/strap-analyze.t +++ b/lib/Test/Harness/t/strap-analyze.t @@ -14,7 +14,7 @@ my $SAMPLE_TESTS = $ENV{PERL_CORE} ? 'lib/sample-tests' : 't/sample-tests'; use strict; -use Test::More tests => 27; +use Test::More tests => 35; use_ok('Test::Harness::Straps'); @@ -24,6 +24,9 @@ my %samples = ( combined => { passing => 0, + 'exit' => 0, + 'wait' => 0, + max => 10, seen => 10, @@ -59,6 +62,9 @@ my %samples = ( descriptive => { passing => 1, + 'wait' => 0, + 'exit' => 0, + max => 5, seen => 5, @@ -88,6 +94,9 @@ my %samples = ( duplicates => { passing => 0, + 'exit' => 0, + 'wait' => 0, + max => 10, seen => 11, @@ -103,6 +112,9 @@ my %samples = ( head_end => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 4, seen => 4, @@ -118,6 +130,9 @@ my %samples = ( lone_not_bug => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 4, seen => 4, @@ -133,6 +148,9 @@ my %samples = ( head_fail => { passing => 0, + 'exit' => 0, + 'wait' => 0, + max => 4, seen => 4, @@ -150,6 +168,9 @@ my %samples = ( simple => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 5, seen => 5, @@ -165,6 +186,9 @@ my %samples = ( simple_fail => { passing => 0, + 'exit' => 0, + 'wait' => 0, + max => 5, seen => 5, @@ -184,6 +208,9 @@ my %samples = ( 'skip' => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 5, seen => 5, @@ -204,6 +231,9 @@ my %samples = ( skip_all => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 0, seen => 0, skip_all => 'rope', @@ -219,6 +249,9 @@ my %samples = ( 'todo' => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 5, seen => 5, @@ -238,6 +271,9 @@ my %samples = ( taint => { passing => 1, + 'exit' => 0, + 'wait' => 0, + max => 1, seen => 1, @@ -254,6 +290,9 @@ my %samples = ( vms_nit => { passing => 0, + 'exit' => 0, + 'wait' => 0, + max => 2, seen => 2, @@ -265,17 +304,92 @@ my %samples = ( details => [ { 'ok' => 0, actual_ok => 0 }, { 'ok' => 1, actual_ok => 1 }, ], - }, + }, + 'die' => { + passing => 0, + + 'exit' => 1, + 'wait' => 256, + + max => 0, + seen => 0, + + 'ok' => 0, + 'todo' => 0, + 'skip' => 0, + bonus => 0, + + details => [] + }, + + die_head_end => { + passing => 0, + + 'exit' => 1, + 'wait' => 256, + + max => 0, + seen => 4, + + 'ok' => 4, + 'todo' => 0, + 'skip' => 0, + bonus => 0, + + details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 + ], + }, + + die_last_minute => { + passing => 0, + + 'exit' => 1, + 'wait' => 256, + + max => 4, + seen => 4, + + 'ok' => 4, + 'todo' => 0, + 'skip' => 0, + bonus => 0, + + details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 + ], + }, + + bignum => { + passing => 0, + + 'exit' => 0, + 'wait' => 0, + + max => 2, + seen => 4, + + 'ok' => 4, + 'todo' => 0, + 'skip' => 0, + bonus => 0, + + details => [ { 'ok' => 1, actual_ok => 1 }, + { 'ok' => 1, actual_ok => 1 }, + ] + }, ); +$SIG{__WARN__} = sub { + warn @_ unless $_[0] =~ /^Enourmous test number/ || + $_[0] =~ /^Can't detailize/ +}; while( my($test, $expect) = each %samples ) { my $strap = Test::Harness::Straps->new; my %results = $strap->analyze_file("$SAMPLE_TESTS/$test"); - is_deeply($expect->{details}, $results{details}, "$test details" ); + is_deeply($results{details}, $expect->{details}, "$test details" ); delete $expect->{details}; delete $results{details}; - is_deeply($expect, \%results, " the rest" ); + is_deeply(\%results, $expect, " the rest" ); } diff --git a/lib/Test/Harness/t/test-harness.t b/lib/Test/Harness/t/test-harness.t index be15009..f508619 100644 --- a/lib/Test/Harness/t/test-harness.t +++ b/lib/Test/Harness/t/test-harness.t @@ -1,9 +1,12 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; - @INC = '../lib'; + @INC = ('../lib', 'lib'); + } + else { + unshift @INC, 't/lib'; } } @@ -30,41 +33,14 @@ sub GETC {} 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 Test::More; 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"; +plan tests => $Total_tests; use Test::Harness; -$loaded = 1; -ok(1, 'compile'); -######################### End of black magic. +use_ok('Test::Harness'); + BEGIN { %samples = ( @@ -78,7 +54,7 @@ BEGIN { good => 1, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { }, @@ -94,7 +70,7 @@ BEGIN { good => 0, tests => 1, sub_skipped => 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { @@ -112,7 +88,7 @@ BEGIN { good => 1, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { }, @@ -128,7 +104,7 @@ BEGIN { good => 0, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { @@ -136,7 +112,7 @@ BEGIN { }, all_ok => 0, }, - todo => { + 'todo' => { total => { bonus => 1, max => 5, @@ -146,7 +122,7 @@ BEGIN { good => 1, tests => 1, sub_skipped=> 0, - todo => 2, + 'todo' => 2, skipped => 0, }, failed => { }, @@ -162,13 +138,13 @@ BEGIN { good => 1, tests => 1, sub_skipped => 0, - todo => 2, + 'todo' => 2, skipped => 0, }, failed => { }, all_ok => 1, }, - skip => { + 'skip' => { total => { bonus => 0, max => 5, @@ -178,7 +154,7 @@ BEGIN { good => 1, tests => 1, sub_skipped=> 1, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { }, @@ -195,7 +171,7 @@ BEGIN { good => 0, tests => 1, sub_skipped=> 1, - todo => 2, + 'todo' => 2, skipped => 0 }, failed => { @@ -213,7 +189,7 @@ BEGIN { good => 0, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { @@ -231,7 +207,7 @@ BEGIN { good => 1, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { }, @@ -247,7 +223,7 @@ BEGIN { good => 0, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { @@ -265,7 +241,7 @@ BEGIN { good => 1, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 1, }, failed => { }, @@ -281,7 +257,7 @@ BEGIN { good => 1, tests => 1, sub_skipped=> 0, - todo => 4, + 'todo' => 4, skipped => 0, }, failed => { }, @@ -297,15 +273,102 @@ BEGIN { good => 1, tests => 1, sub_skipped=> 0, - todo => 0, + 'todo' => 0, skipped => 0, }, failed => { }, all_ok => 1, }, + + 'die' => { + total => { + bonus => 0, + max => 0, + 'ok' => 0, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + 'todo' => 0, + skipped => 0, + }, + failed => { + estat => 1, + wstat => 256, + max => '??', + failed => '??', + canon => '??', + }, + all_ok => 0, + }, + + die_head_end => { + total => { + bonus => 0, + max => 0, + 'ok' => 4, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + 'todo' => 0, + skipped => 0, + }, + failed => { + estat => 1, + wstat => 256, + max => '??', + failed => '??', + canon => '??', + }, + all_ok => 0, + }, + + die_last_minute => { + total => { + bonus => 0, + max => 4, + 'ok' => 4, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + 'todo' => 0, + skipped => 0, + }, + failed => { + estat => 1, + wstat => 256, + max => 4, + failed => 0, + canon => '??', + }, + all_ok => 0, + }, + bignum => { + total => { + bonus => 0, + max => 2, + 'ok' => 4, + files => 1, + bad => 1, + good => 0, + tests => 1, + sub_skipped=> 0, + 'todo' => 0, + skipped => 0, + }, + failed => { + canon => '??', + }, + all_ok => 0, + }, ); - $Total_tests = (keys(%samples) * 4); + $Total_tests = (keys(%samples) * 4) + 1; } tie *NULL, 'My::Dev::Null' or die $!; @@ -321,21 +384,21 @@ while (my($test, $expect) = each %samples) { select STDOUT; unless( $@ ) { - ok( Test::Harness::_all_ok($totals) == $expect->{all_ok}, + is( 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}}} ), + is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}}, + $expect->{total}, "$test - totals" ); - ok( eqhash( $expect->{failed}, - {map { $_=>$failed->{"$SAMPLE_TESTS/$test"}{$_} } - keys %{$expect->{failed}}} ), + is_deeply( {map { $_=>$failed->{"$SAMPLE_TESTS/$test"}{$_} } + keys %{$expect->{failed}}}, + $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' ); + is( $test, 'bailout' ); + like( $@, '/Further testing stopped: GERONI/i', $test ); + pass( 'skipping for bailout' ); + pass( 'skipping for bailout' ); } } diff --git a/t/lib/sample-tests/bignum b/t/lib/sample-tests/bignum new file mode 100644 index 0000000..3f51d38 --- /dev/null +++ b/t/lib/sample-tests/bignum @@ -0,0 +1,7 @@ +print <