Test.pm 1.18 -> 1.20

Message-ID: <20020310221410.GA4915@blackrider>

p4raw-id: //depot/perl@15156

6 files changed, 61 insertions, 39 deletions

diff --git a/lib/Test.pm b/lib/Test.pm
index dcc5f68698..d497217ff1 100644
--- a/lib/Test.pm
+++ b/lib/Test.pm
@@ -6,20 +6,30 @@ use strict;
 
 use Carp;
 use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish
-	  qw($TESTOUT $ONFAIL %todo %history $planned @FAILDETAIL)#private-ish
+          qw($TESTOUT $TESTERR
+             $ONFAIL %todo %history $planned @FAILDETAIL) #private-ish
          );
 
-$VERSION = '1.18';
+# In case a test is run in a persistent environment.
+sub _reset_globals {
+    %todo       = ();
+    %history    = ();
+    @FAILDETAIL = ();
+    $ntest      = 1;
+    $TestLevel  = 0;		# how many extra stack frames to skip
+    $planned    = 0;
+}
+
+$VERSION = '1.20';
 require Exporter;
 @ISA=('Exporter');
 
 @EXPORT    = qw(&plan &ok &skip);
-@EXPORT_OK = qw($ntest $TESTOUT);
+@EXPORT_OK = qw($ntest $TESTOUT $TESTERR);
 
-$TestLevel = 0;		# how many extra stack frames to skip
 $|=1;
-$ntest=1;
 $TESTOUT = *STDOUT{IO};
+$TESTERR = *STDERR{IO};
 
 # Use of this variable is strongly discouraged.  It is set mainly to
 # help test coverage analyzers know which test is running.
@@ -112,6 +122,8 @@ sub plan {
     local($\, $,);   # guard against -l and other things that screw with
                      # print
 
+    _reset_globals();
+
     my $max=0;
     for (my $x=0; $x < @_; $x+=2) {
 	my ($k,$v) = @_[$x,$x+1];
@@ -275,13 +287,13 @@ sub ok ($;$$) {
 	    $context .= ' *TODO*' if $todo;
 	    if (!defined $expected) {
 		if (!$diag) {
-		    print $TESTOUT "# Failed test $ntest in $context\n";
+		    print $TESTERR "# Failed test $ntest in $context\n";
 		} else {
-		    print $TESTOUT "# Failed test $ntest in $context: $diag\n";
+		    print $TESTERR "# Failed test $ntest in $context: $diag\n";
 		}
 	    } else {
 		my $prefix = "Test $ntest";
-		print $TESTOUT "# $prefix got: ".
+		print $TESTERR "# $prefix got: ".
 		    (defined $result? "'$result'":'<UNDEF>')." ($context)\n";
 		$prefix = ' ' x (length($prefix) - 5);
 		if (defined $regex) {
@@ -291,9 +303,9 @@ sub ok ($;$$) {
 		    $expected = "'$expected'";
 		}
 		if (!$diag) {
-		    print $TESTOUT "# $prefix Expected: $expected\n";
+		    print $TESTERR "# $prefix Expected: $expected\n";
 		} else {
-		    print $TESTOUT "# $prefix Expected: $expected ($diag)\n";
+		    print $TESTERR "# $prefix Expected: $expected ($diag)\n";
 		}
 	    }
 	    push @FAILDETAIL, $detail;
@@ -424,34 +436,33 @@ Again, best bet is to use the single argument form:
     ok( $fileglob eq '/path/to/some/*stuff/' );
 
 
-=head1 TODO
+=head1 NOTE
 
-Add todo().
-
-Allow named tests.
-
-Implement noplan().
+This module is no longer actively being developed, only bug fixes and
+small tweaks (I'll still accept patches).  If you desire additional
+functionality, consider L<Test::More> or L<Test::Unit>.
 
 
 =head1 SEE ALSO
 
 L<Test::Simple>, L<Test::More>, L<Test::Harness>, L<Devel::Cover>
 
-L<Test::Unit> is an interesting alternative testing library.
+L<Test::Builder> for building your own testing library.
+
+L<Test::Unit> is an interesting XUnit-style testing library.
 
-L<Pod::Tests> and L<SelfTest> let you embed tests in code.
+L<Test::Inline> and L<SelfTest> let you embed tests in code.
 
 
 =head1 AUTHOR
 
 Copyright (c) 1998-2000 Joshua Nathaniel Pritikin.  All rights reserved.
-Copyright (c) 2001      Michael G Schwern.
+Copyright (c) 2001-2002 Michael G Schwern.
 
 Current maintainer, Michael G Schwern <schwern@pobox.com>
 
 This package is free software and is provided "as is" without express
 or implied warranty.  It may be used, redistributed and/or modified
-under the terms of the Perl Artistic License (see
-http://www.perl.com/perl/misc/Artistic.html)
+under the same terms as Perl itself.
 
 =cut
diff --git a/lib/Test/t/fail.t b/lib/Test/t/fail.t
index b431502b8a..ce37464d04 100644
--- a/lib/Test/t/fail.t
+++ b/lib/Test/t/fail.t
@@ -1,11 +1,12 @@
 # -*-perl-*-
 use strict;
 use vars qw($Expect);
-use Test qw($TESTOUT $ntest ok skip plan); 
+use Test qw($TESTOUT $TESTERR $ntest ok skip plan); 
 plan tests => 14;
 
 open F, ">fails";
 $TESTOUT = *F{IO};
+$TESTERR = *F{IO};
 
 my $r=0;
 {
@@ -32,6 +33,7 @@ ok($r); # (failure==success :-)
 
 close F;
 $TESTOUT = *STDOUT{IO};
+$TESTERR = *STDERR{IO};
 $ntest = 1;
 
 open F, "fails";
@@ -56,38 +58,38 @@ for (my $x=0; $x < @got; $x++) {
 
 BEGIN {
     $Expect = <<"EXPECT";
-# Failed test 1 in $0 at line 14
+# Failed test 1 in $0 at line 15
 
-# Failed test 2 in $0 at line 16
+# Failed test 2 in $0 at line 17
 
-# Test 3 got: '0' ($0 at line 17)
+# Test 3 got: '0' ($0 at line 18)
 #   Expected: '1'
 
-# Test 4 got: '2' ($0 at line 18)
+# Test 4 got: '2' ($0 at line 19)
 #   Expected: '3'
 
-# Test 5 got: '2' ($0 at line 19)
+# Test 5 got: '2' ($0 at line 20)
 #   Expected: '0'
 
-# Test 6 got: '2' ($0 at line 22)
+# Test 6 got: '2' ($0 at line 23)
 #   Expected: '1' (\@list=0,0)
 
-# Test 7 got: '2' ($0 at line 23)
+# Test 7 got: '2' ($0 at line 24)
 #   Expected: '1' (\@list=0,0)
 
-# Test 8 got: 'segmentation fault' ($0 at line 24)
+# Test 8 got: 'segmentation fault' ($0 at line 25)
 #   Expected: qr{bongo}
 
-# Failed test 9 in $0 at line 26
+# Failed test 9 in $0 at line 27
 
-# Failed test 10 in $0 at line 26 fail #2
+# Failed test 10 in $0 at line 27 fail #2
 
-# Failed test 11 in $0 at line 28
+# Failed test 11 in $0 at line 29
 
-# Test 12 got: <UNDEF> ($0 at line 29)
+# Test 12 got: <UNDEF> ($0 at line 30)
 #    Expected: '1'
 
-# Failed test 13 in $0 at line 31
+# Failed test 13 in $0 at line 32
 EXPECT
 
 }
diff --git a/lib/Test/t/mix.t b/lib/Test/t/mix.t
index d2dd491330..a746ba66b5 100644
--- a/lib/Test/t/mix.t
+++ b/lib/Test/t/mix.t
@@ -1,6 +1,6 @@
 # -*-perl-*-
 use strict;
-use Test qw(:DEFAULT $TESTOUT $ntest);
+use Test qw(:DEFAULT $TESTOUT $TESTERR $ntest);
 
 ### This test is crafted in such a way as to prevent Test::Harness from
 ### seeing the todo tests, otherwise you get people sending in bug reports
@@ -8,6 +8,7 @@ use Test qw(:DEFAULT $TESTOUT $ntest);
 
 open F, ">mix";
 $TESTOUT = *F{IO};
+$TESTERR = *F{IO};
 
 plan tests => 4, todo => [2,3];
 
@@ -27,6 +28,7 @@ skip(1,0);
 
 close F;
 $TESTOUT = *STDOUT{IO};
+$TESTERR = *STDERR{IO};
 $ntest = 1;
 
 open F, "mix";
diff --git a/lib/Test/t/onfail.t b/lib/Test/t/onfail.t
index dce4373401..85fe9eb884 100644
--- a/lib/Test/t/onfail.t
+++ b/lib/Test/t/onfail.t
@@ -1,7 +1,7 @@
 # -*-perl-*-
 
 use strict;
-use Test qw($ntest plan ok $TESTOUT);
+use Test qw($ntest plan ok $TESTOUT $TESTERR);
 use vars qw($mycnt);
 
 BEGIN { plan test => 6, onfail => \&myfail }
@@ -12,8 +12,10 @@ my $why = "zero != one";
 # sneak in a test that Test::Harness wont see
 open J, ">junk";
 $TESTOUT = *J{IO};
+$TESTERR = *J{IO};
 ok(0, 1, $why);
 $TESTOUT = *STDOUT{IO};
+$TESTERR = *STDERR{IO};
 close J;
 unlink "junk";
 $ntest = 1;
diff --git a/lib/Test/t/skip.t b/lib/Test/t/skip.t
index 7db35e65dc..a6d1cf4c3c 100644
--- a/lib/Test/t/skip.t
+++ b/lib/Test/t/skip.t
@@ -1,9 +1,11 @@
 # -*-perl-*-
 use strict;
-use Test qw($TESTOUT $ntest plan ok skip); plan tests => 6;
+use Test qw($TESTOUT $TESTERR $ntest plan ok skip); 
+plan tests => 6;
 
 open F, ">skips" or die "open skips: $!";
 $TESTOUT = *F{IO};
+$TESTERR = *F{IO};
 
 skip(1, 0);  #should skip
 
@@ -15,6 +17,7 @@ skip('skipping stones is more fun', sub { $skipped = 0 });
 close F;
 
 $TESTOUT = *STDOUT{IO};
+$TESTERR = *STDERR{IO};
 $ntest = 1;
 open F, "skips" or die "open skips: $!";
 
diff --git a/lib/Test/t/todo.t b/lib/Test/t/todo.t
index 510e80dbd3..2f179e4547 100644
--- a/lib/Test/t/todo.t
+++ b/lib/Test/t/todo.t
@@ -1,6 +1,6 @@
 # -*-perl-*-
 use strict;
-use Test qw(:DEFAULT $TESTOUT $ntest);
+use Test qw(:DEFAULT $TESTOUT $TESTERR $ntest);
 
 ### This test is crafted in such a way as to prevent Test::Harness from
 ### seeing the todo tests, otherwise you get people sending in bug reports
@@ -8,6 +8,7 @@ use Test qw(:DEFAULT $TESTOUT $ntest);
 
 open F, ">todo";
 $TESTOUT = *F{IO};
+$TESTERR = *F{IO};
 
 my $tests = 5; 
 plan tests => $tests, todo => [2..$tests]; 
@@ -21,6 +22,7 @@ ok(1,1);
 
 close F;
 $TESTOUT = *STDOUT{IO};
+$TESTERR = *STDERR{IO};
 $ntest = 1;
 
 open F, "todo";