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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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";