From: Michael G. Schwern Date: Fri, 17 May 2002 20:37:26 +0000 (-0400) Subject: Test::Harness 2.21 -> 2.22 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6e5a998b1cc5eddc2fb262c2e2e7f989bfb76f23;p=p5sagit%2Fp5-mst-13.2.git Test::Harness 2.21 -> 2.22 Message-ID: <20020518003726.GB358@ool-18b93024.dyn.optonline.net> p4raw-id: //depot/perl@16668 --- diff --git a/MANIFEST b/MANIFEST index bcff43b..325fbe7 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2368,6 +2368,7 @@ 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/out_of_order 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 diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index fb2aa9a..ac3ac8e 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.28 2002/05/06 04:44:29 schwern Exp $ +# $Id: Harness.pm,v 1.29 2002/05/17 23:04:11 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.21'; +$VERSION = '2.22'; $ENV{HARNESS_ACTIVE} = 1; diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes index cfc1bff..f715aec 100644 --- a/lib/Test/Harness/Changes +++ b/lib/Test/Harness/Changes @@ -1,5 +1,10 @@ Revision history for Perl extension Test::Harness +2.22 Fri May 17 19:01:35 EDT 2002 + - Fixed parsing of #!/usr/bin/perl-current to not see a -t. + (RT #574) + - Fixed exit codes on MPE/iX + 2.21 Mon May 6 00:43:22 EDT 2002 - removed a bunch of dead code left over after 2.20's gutting. - The fix for the $^X "bug" added in 2.02 has been removed. It diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm index 73cc009..173b26b 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.4 2002/05/05 02:32:54 schwern Exp $ +# $Id: Straps.pm,v 1.6 2002/05/17 23:04:11 schwern Exp $ package Test::Harness::Straps; use strict; use vars qw($VERSION); use Config; -$VERSION = '0.10'; +$VERSION = '0.11'; use Test::Harness::Assert; use Test::Harness::Iterator; @@ -277,7 +277,7 @@ sub analyze_file { eval q{use vmsish "status"; $results{'exit'} = $?}; } else { - $results{'exit'} = $? / 256; + $results{'exit'} = _wait2exit($?); } $results{passing} = 0 unless $? == 0; @@ -286,6 +286,16 @@ sub analyze_file { return %results; } + +eval { require POSIX; &POSIX::WEXITSTATUS(0) }; +if( $@ ) { + *_wait2exit = sub { $_[0] >> 8 }; +} +else { + *_wait2exit = sub { POSIX::WEXITSTATUS($_[0]) } +} + + =begin _private =item B<_switches> @@ -306,7 +316,7 @@ sub _switches { $s .= " $ENV{'HARNESS_PERL_SWITCHES'}" if exists $ENV{'HARNESS_PERL_SWITCHES'}; $s .= join " ", qq[ "-$1"], map {qq["-I$_"]} $self->_filtered_INC - if $first =~ /^#!.*\bperl.*-\w*([Tt]+)/; + if $first =~ /^#!.*\bperl.*\s-\w*([Tt]+)/; close(TEST) or print "can't close $file. $!\n"; diff --git a/lib/Test/Harness/t/strap-analyze.t b/lib/Test/Harness/t/strap-analyze.t index 9636557..f7da98c 100644 --- a/lib/Test/Harness/t/strap-analyze.t +++ b/lib/Test/Harness/t/strap-analyze.t @@ -13,10 +13,7 @@ BEGIN { my $SAMPLE_TESTS = $ENV{PERL_CORE} ? 'lib/sample-tests' : 't/sample-tests'; use strict; - -use Test::More tests => 35; - -use_ok('Test::Harness::Straps'); +use Test::More; my $IsVMS = $^O eq 'VMS'; @@ -380,8 +377,29 @@ my %samples = ( { 'ok' => 1, actual_ok => 1 }, ] }, + + 'shbang_misparse' =>{ + passing => 1, + + 'exit' => 0, + 'wait' => 0, + + max => 2, + seen => 2, + + 'ok' => 2, + 'todo' => 0, + 'skip' => 0, + bonus => 0, + + details => [ ({ 'ok' => 1, actual_ok => 1 }) x 2 ] + }, ); +plan tests => (keys(%samples) * 2) + 1; + +use_ok('Test::Harness::Straps'); + $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /^Enourmous test number/ || $_[0] =~ /^Can't detailize/ diff --git a/lib/Test/Harness/t/test-harness.t b/lib/Test/Harness/t/test-harness.t index 4e416e0..5bfdb4e 100644 --- a/lib/Test/Harness/t/test-harness.t +++ b/lib/Test/Harness/t/test-harness.t @@ -364,6 +364,22 @@ my %samples = ( }, all_ok => 0, }, + 'shbang_misparse' => { + total => { + bonus => 0, + max => 2, + 'ok' => 2, + files => 1, + bad => 0, + good => 1, + tests => 1, + sub_skipped=> 0, + 'todo' => 0, + skipped => 0, + }, + failed => { }, + all_ok => 1, + }, ); plan tests => (keys(%samples) * 7) + 1; diff --git a/t/lib/sample-tests/shbang_misparse b/t/lib/sample-tests/shbang_misparse new file mode 100644 index 0000000..bc1b524 --- /dev/null +++ b/t/lib/sample-tests/shbang_misparse @@ -0,0 +1,12 @@ +#!/usr/bin/perl-latest + +# The above #! line was misparsed as having a -t. +# Pre-5.8 this will simply cause perl to choke, since there was no -t. +# Post-5.8 taint warnings will mistakenly be on. + +print "1..2\n"; +print "ok 1\n"; +my $warning = ''; +$SIG{__WARN__} = sub { $warning .= $_[0] }; +eval("#" . substr($0, 0, 0)); +print $warning ? "not ok 2\n" : "ok 2\n";