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
# -*- 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;
$Have_Devel_Corestack = 0;
-$VERSION = '2.26';
+$VERSION = '2.27_02';
$ENV{HARNESS_ACTIVE} = 1;
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,
);
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}")
$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}});
};
}
$tot{bad}++;
- } elsif ($test{'next'} == 0) {
+ } else {
print "FAILED before any test output arrived\n";
$tot{bad}++;
$failedtests{$tfile} = { canon => '??',
_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 {
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++;
Current maintainer is Michael G Schwern E<lt>schwern@pobox.comE<gt>
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+
=head1 TODO
Provide a way of running tests quietly (ie. no printing) for automated
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).
# -*- 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;
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
$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;
$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";
}
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);
$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;
: 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;
],
},
+ no_output => {
+ passing => 0,
+
+ 'exit' => 0,
+ 'wait' => 0,
+
+ max => 0,
+ seen => 0,
+
+ 'ok' => 0,
+ 'todo' => 0,
+ 'skip' => 0,
+ bonus => 0,
+
+ details => [],
+ },
+
simple => {
passing => 1,
max => 0,
seen => 0,
+ skip_all => '',
'ok' => 0,
'todo' => 0,
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' );
use strict;
-use Test::More tests => 146;
+use Test::More tests => 147;
use_ok('Test::Harness::Straps');
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',
},
},
'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'
}
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 => {
},
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,
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;
};
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';
--- /dev/null
+#!/usr/bin/perl -w
+
+exit;
--- /dev/null
+#!/usr/bin/perl
+
+print "1..1\n";
+print "ok 1\n";
+kill 11, $$;
--- /dev/null
+print <<DUMMY;
+1..3
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+ok 6
+ok 7
+DUMMY
+
+exit 4; # simulate Test::More's exit status
+
+
projects / p5sagit/p5-mst-13.2.git / commitdiff