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
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
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
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
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
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
# -*- 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;
$Have_Devel_Corestack = 0;
-$VERSION = "1.21";
+$VERSION = 1.25;
$ENV{HARNESS_ACTIVE} = 1;
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
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;
=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;
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
good => 0,
tests => scalar @tests,
sub_skipped => 0,
+ todo => 0,
skipped => 0,
- bench => 0
+ bench => 0,
);
# pass -I flags to children
# 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);
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;
);
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;
$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}) {
}
}
- $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);
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; }
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",
# 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) ) {
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?
}
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'}) {
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;
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 = $?'
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};
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 $@;
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, ";
--- /dev/null
+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.
+
+
--- /dev/null
+#!perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use strict;
+
+# For shutting up Test::Harness.
+# Has to work on 5.004, which doesn't have Tie::StdHandle.
+package My::Dev::Null;
+
+sub WRITE {}
+sub PRINT {}
+sub PRINTF {}
+sub TIEHANDLE {
+ my $class = shift;
+ my $fh = do { local *HANDLE; \*HANDLE };
+ return bless $fh, $class;
+}
+sub READ {}
+sub READLINE {}
+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 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 );
+ }
+}
https://perl5.git.perl.org / perl5.git / commitdiff