Upgrade to Test::Harness 2.27_02.

p4raw-id: //depot/perl@19102

diff --git a/MANIFEST b/MANIFEST
index 91b9a41..6a8c4de 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2487,17 +2487,20 @@ t/lib/sample-tests/head_end             Test data for Test::Harness
 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/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/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/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/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/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
 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

diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index efb9a1f..50de3b5 100644 (file)
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -1,5 +1,5 @@
 # -*- Mode: cperl; cperl-indent-level: 4 -*-
 # -*- 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;
 
 
 package Test::Harness;
 


@@ -22,7 +22,7 @@ use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest
 
 $Have_Devel_Corestack = 0;
 
 
 $Have_Devel_Corestack = 0;
 

-$VERSION = '2.26';
+$VERSION = '2.27_02';

 
 $ENV{HARNESS_ACTIVE} = 1;
 
 
 $ENV{HARNESS_ACTIVE} = 1;
 


@@ -469,7 +469,7 @@ sub _run_all_tests {
                     failed      => \@failed,
                     bonus       => $results{bonus},
                     skipped     => $results{skip},
                     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,
                    );
                     skip_all    => $Strap->{skip_all},
                     ml          => $ml,
                    );


@@ -482,12 +482,7 @@ sub _run_all_tests {
 
         my($estatus, $wstatus) = @results{qw(exit wait)};
 
 
         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}")
             if ($test{max} and $test{skipped} + $test{bonus}) {
                 my @msg;
                 push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")


@@ -507,10 +502,26 @@ sub _run_all_tests {
             $tot{good}++;
         }
         else {
             $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}});
                 if (@{$test{failed}}) {
                     my ($txt, $canon) = canonfailed($test{max},$test{skipped},
                                                     @{$test{failed}});


@@ -536,7 +547,7 @@ sub _run_all_tests {
                                            };
                 }
                 $tot{bad}++;
                                            };
                 }
                 $tot{bad}++;

-            } elsif ($test{'next'} == 0) {
+            } else {

                 print "FAILED before any test output arrived\n";
                 $tot{bad}++;
                 $failedtests{$tfile} = { canon       => '??',
                 print "FAILED before any test output arrived\n";
                 $tot{bad}++;
                 $failedtests{$tfile} = { canon       => '??',


@@ -697,10 +708,10 @@ $Handlers{test} = sub {
         _print_ml("ok $curr/$max");
 
         if( $detail->{type} eq 'skip' ) {
         _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 {
         }
     }
     else {


@@ -858,12 +869,15 @@ sub _create_fmts {
     sub corestatus {
         my($st) = @_;
 
     sub corestatus {
         my($st) = @_;
 

-        eval {
+        my $did_core;
+        eval { # we may not have a WCOREDUMP

             local $^W = 0;  # *.ph files are often *very* noisy
             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++;
 
         eval { require Devel::CoreStack; $Have_Devel_Corestack++ } 
           unless $tried_devel_corestack++;


@@ -1058,6 +1072,14 @@ exist.  Andreas Koenig held the torch for many years.
 
 Current maintainer is Michael G Schwern E<lt>schwern@pobox.comE<gt>
 
 
 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
 =head1 TODO
 
 Provide a way of running tests quietly (ie. no printing) for automated

diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes
index 892c243..1287d9a 100644 (file)
--- a/lib/Test/Harness/Changes
+++ b/lib/Test/Harness/Changes
@@ -1,5 +1,22 @@
 Revision history for Perl extension Test::Harness
 
 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).
 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).

diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm
index 7530045..6ce6b2d 100644 (file)
--- a/lib/Test/Harness/Straps.pm
+++ b/lib/Test/Harness/Straps.pm
@@ -1,5 +1,5 @@
 # -*- Mode: cperl; cperl-indent-level: 4 -*-
 # -*- 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;
 
 
 package Test::Harness::Straps;
 


@@ -93,7 +93,8 @@ Initialize the internal state of a strap to make it ready for parsing.
 sub _init {
     my($self) = shift;
 
 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
 }
 
 =end _private


@@ -150,10 +151,10 @@ sub _analyze_iterator {
 
     $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all};
 
 
     $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{passing} = $passed ? 1 : 0;
 
     return %totals;


@@ -206,7 +207,7 @@ sub _analyze_line {
 
         $totals->{ok}++ if $pass;
 
 
         $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";
         }
             warn "Enormous test number seen [test $result{number}]\n";
             warn "Can't detailize, too big.\n";
         }


@@ -269,8 +270,9 @@ sub analyze_file {
 
     local $ENV{PERL5LIB} = $self->_INC2PERL5LIB;
 
 
     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);
 
 
     my $switches = $self->_switches($file);
 


@@ -467,7 +469,11 @@ sub _is_header {
 
             $self->{todo} = { map { $_ => 1 } split /\s+/, $todo } if $todo;
 
 
             $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;
         }
 
         return $YES;

diff --git a/lib/Test/Harness/t/strap-analyze.t b/lib/Test/Harness/t/strap-analyze.t
index 02fa1d6..b42c875 100644 (file)
--- a/lib/Test/Harness/t/strap-analyze.t
+++ b/lib/Test/Harness/t/strap-analyze.t
@@ -20,11 +20,11 @@ my $SAMPLE_TESTS = $ENV{PERL_CORE}
                     : File::Spec->catdir($Curdir, 't',   'sample-tests');
 
 
                     : 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 $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;
 
 # We can only predict that the wait status should be zero or not.
 my $wait_non_zero = 1;


@@ -174,6 +174,23 @@ my %samples = (
                                        ],
                           },
 
                                        ],
                           },
 

+   no_output        => {
+                        passing     => 0,
+
+                        'exit'      => 0,
+                        'wait'      => 0,
+
+                        max         => 0,
+                        seen        => 0,
+
+                        'ok'        => 0,
+                        'todo'      => 0,
+                        'skip'      => 0,
+                        bonus       => 0,
+
+                        details     => [],
+                       },
+

    simple           => {
                         passing     => 1,
 
    simple           => {
                         passing     => 1,
 


@@ -284,6 +301,7 @@ my %samples = (
 
                           max       => 0,
                           seen      => 0,
 
                           max       => 0,
                           seen      => 0,

+                          skip_all  => '',

 
                           'ok'      => 0,
                           'todo'    => 0,
 
                           'ok'      => 0,
                           'todo'    => 0,


@@ -470,7 +488,7 @@ while( my($test, $expect) = each %samples ) {
     delete $results{details};
 
     SKIP: {
     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' );
 
         # We can only check if it's zero or non-zero.
         is( !!$results{'wait'}, !!$expect->{'wait'}, 'wait status' );

diff --git a/lib/Test/Harness/t/strap.t b/lib/Test/Harness/t/strap.t
index 26af9f3..a69f0c6 100644 (file)
--- a/lib/Test/Harness/t/strap.t
+++ b/lib/Test/Harness/t/strap.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use strict;
 
 
 use strict;
 

-use Test::More tests => 146;
+use Test::More tests => 147;

 
 
 use_ok('Test::Harness::Straps');
 
 
 use_ok('Test::Harness::Straps');


@@ -72,7 +72,9 @@ my @attribs = qw(max skip_all todo);
 my %headers = (
    '1..2'                               => { max => 2 },
    '1..1'                               => { max => 1 },
 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..0 # Skipped: no leverage found'  => { max      => 0,
                                              skip_all => 'no leverage found',
                                            },


@@ -84,17 +86,17 @@ my %headers = (
                                            },
    '1..10 todo 2 4 10'                  => { max        => 10,
                                              'todo'       => { 2  => 1,
                                            },
    '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, 
                                                            },
                                            },
    '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'
                                            }
                                                         },
                                              skip_all => 'skip skip because'
                                            }

diff --git a/lib/Test/Harness/t/test-harness.t b/lib/Test/Harness/t/test-harness.t
index e9f99c8..f8d8c28 100644 (file)
--- a/lib/Test/Harness/t/test-harness.t
+++ b/lib/Test/Harness/t/test-harness.t
@@ -40,11 +40,14 @@ package main;
 
 use Test::More;
 
 
 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 $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            => {
 
 my %samples = (
             simple            => {


@@ -250,6 +253,23 @@ my %samples = (
                                             },
                                   all_ok => 0,
                                  },
                                             },
                                   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,
             skipall          => {
                                   total => {
                                             bonus      => 0,


@@ -414,6 +434,24 @@ my %samples = (
                                   failed => { },
                                   all_ok => 1,
                                  },
                                   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;
            );
 
 plan tests => (keys(%samples) * 8) + 1;


@@ -438,8 +476,8 @@ while (my($test, $expect) = each %samples) {
     };
     select STDOUT;
 
     };
     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';
 
     SKIP: {
         skip "special tests for bailout", 1 unless $test eq 'bailout';

diff --git a/t/lib/sample-tests/no_output b/t/lib/sample-tests/no_output
new file mode 100644 (file)
index 0000000..505acda
--- /dev/null
+++ b/t/lib/sample-tests/no_output
@@ -0,0 +1,3 @@
+#!/usr/bin/perl -w
+
+exit;

diff --git a/t/lib/sample-tests/segfault b/t/lib/sample-tests/segfault
new file mode 100644 (file)
index 0000000..c5670a4
--- /dev/null
+++ b/t/lib/sample-tests/segfault
@@ -0,0 +1,5 @@
+#!/usr/bin/perl
+
+print "1..1\n";
+print "ok 1\n";
+kill 11, $$;

diff --git a/t/lib/sample-tests/too_many b/t/lib/sample-tests/too_many
new file mode 100644 (file)
index 0000000..46acade
--- /dev/null
+++ b/t/lib/sample-tests/too_many
@@ -0,0 +1,14 @@
+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
+
+