Test::Simple/More/Builder 0.44 -> 0.45

Message-id: <20020620001111.GW1232@ool-18b93024.dyn.optonline.net>

p4raw-id: //depot/perl@17315

8 files changed, 176 insertions, 41 deletions

diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm
index 7c710bf00f..06543e696e 100644
--- a/lib/Test/Builder.pm
+++ b/lib/Test/Builder.pm
@@ -8,7 +8,7 @@ $^C ||= 0;
 
 use strict;
 use vars qw($VERSION $CLASS);
-$VERSION = '0.14';
+$VERSION = '0.15';
 $CLASS = __PACKAGE__;
 
 my $IsVMS = $^O eq 'VMS';
@@ -20,6 +20,22 @@ my($Test_Died) = 0;
 my($Have_Plan) = 0;
 my $Curr_Test = 0;
 
+# Make Test::Builder thread-safe for ithreads.
+BEGIN {
+    use Config;
+    if( $] >= 5.008 && $Config{useithreads} ) {
+        require threads;
+        require threads::shared;
+        threads::shared->import;
+        share(\$Curr_Test);
+        share(\@Test_Details);
+        share(\@Test_Results);
+    }
+    else {
+        *lock = sub { 0 };
+    }
+}
+
 
 =head1 NAME
 
@@ -131,6 +147,11 @@ sub plan {
 
     return unless $cmd;
 
+    if( $Have_Plan ) {
+        die sprintf "You tried to plan twice!  Second plan at %s line %d\n",
+          ($self->caller)[1,2];
+    }
+
     if( $cmd eq 'no_plan' ) {
         $self->no_plan;
     }
@@ -154,7 +175,8 @@ sub plan {
         my @args = grep { defined } ($cmd, $arg);
         Carp::croak("plan() doesn't understand @args");
     }
-        
+
+    return 1;
 }
 
 =item B<expected_tests>
@@ -246,8 +268,9 @@ sub ok {
         Carp::croak("You tried to run a test without a plan!  Gotta have a plan.");
     }
 
+    lock $Curr_Test;
     $Curr_Test++;
-    
+
     $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
     You named your test '$name'.  You shouldn't use numbers for your test names.
     Very confusing.
@@ -604,6 +627,7 @@ sub skip {
         Carp::croak("You tried to run tests without a plan!  Gotta have a plan.");
     }
 
+    lock($Curr_Test);
     $Curr_Test++;
 
     $Test_Results[$Curr_Test-1] = 1;
@@ -639,6 +663,7 @@ sub todo_skip {
         Carp::croak("You tried to run tests without a plan!  Gotta have a plan.");
     }
 
+    lock($Curr_Test);
     $Curr_Test++;
 
     $Test_Results[$Curr_Test-1] = 1;
@@ -990,8 +1015,8 @@ You usually shouldn't have to set this.
 sub current_test {
     my($self, $num) = @_;
 
+    lock($Curr_Test);
     if( defined $num ) {
-
         unless( $Have_Plan ) {
             require Carp;
             Carp::croak("Can't change the current test number without a plan!");
@@ -1083,7 +1108,7 @@ Like the normal caller(), except it reports according to your level().
 sub caller {
     my($self, $height) = @_;
     $height ||= 0;
-    
+
     my @caller = CORE::caller($self->level + $height + 1);
     return wantarray ? @caller : $caller[0];
 }
@@ -1188,6 +1213,11 @@ sub _ending {
             $Expected_Tests = $Curr_Test;
         }
 
+        # 5.8.0 threads bug.  Shared arrays will not be auto-extended 
+        # by a slice.
+        $Test_Results[$Expected_Tests-1] = undef
+          unless defined $Test_Results[$Expected_Tests-1];
+
         my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
         $num_failed += abs($Expected_Tests - @Test_Results);
 
@@ -1231,9 +1261,16 @@ END {
     $Test->_ending if defined $Test and !$Test->no_ending;
 }
 
+=head1 THREADS
+
+In perl 5.8.0 and later, Test::Builder is thread-safe.  The test
+number is shared amongst all threads.  This means if one thread sets
+the test number using current_test() they will all be effected.
+
 =head1 EXAMPLES
 
-At this point, Test::Simple and Test::More are your best examples.
+CPAN can provide the best examples.  Test::Simple, Test::More,
+Test::Exception and Test::Differences all use Test::Builder.
 
 =head1 SEE ALSO
 
diff --git a/lib/Test/More.pm b/lib/Test/More.pm
index b97f967ff7..9be5ea8b92 100644
--- a/lib/Test/More.pm
+++ b/lib/Test/More.pm
@@ -18,7 +18,7 @@ sub _carp {
 
 require Exporter;
 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.44';
+$VERSION = '0.45';
 @ISA    = qw(Exporter);
 @EXPORT = qw(ok use_ok require_ok
              is isnt like unlike is_deeply
@@ -658,6 +658,20 @@ is like doing this:
 
    use Some::Module qw(foo bar);
 
+don't try to do this:
+
+   BEGIN {
+       use_ok('Some::Module');
+
+       ...some code that depends on the use...
+       ...happening at compile time...
+   }
+
+instead, you want:
+
+  BEGIN { use_ok('Some::Module') }
+  BEGIN { ...some code that depends on the use... }
+
 
 =cut
 
@@ -749,40 +763,34 @@ just show you...
       ...normal testing code goes here...
   }
 
-This declares a block of tests to skip, $how_many tests there are,
-$why and under what $condition to skip them.  An example is the
-easiest way to illustrate:
+This declares a block of tests that might be skipped, $how_many tests
+there are, $why and under what $condition to skip them.  An example is
+the easiest way to illustrate:
 
     SKIP: {
-        skip "Pigs don't fly here", 2 unless Pigs->can('fly');
+        eval { require HTML::Lint };
 
-        my $pig = Pigs->new;
-        $pig->takeoff;
+        skip "HTML::Lint not installed", 2 if $@;
 
-        ok( $pig->altitude > 0,         'Pig is airborne' );
-        ok( $pig->airspeed > 0,         '  and moving'    );
-    }
+        my $lint = new HTML::Lint;
+        ok( $lint, "Created object" );
 
-If pigs cannot fly, the whole block of tests will be skipped
-completely.  Test::More will output special ok's which Test::Harness
-interprets as skipped tests.  It's important to include $how_many tests
-are in the block so the total number of tests comes out right (unless
-you're using C<no_plan>, in which case you can leave $how_many off if
-you like).
+        $lint->parse( $html );
+        is( scalar $lint->errors, 0, "No errors found in HTML" );
+    }
 
-It's perfectly safe to nest SKIP blocks.
+If the user does not have HTML::Lint installed, the whole block of
+code I<won't be run at all>.  Test::More will output special ok's
+which Test::Harness interprets as skipped, but passing, tests.
+It's important that $how_many accurately reflects the number of tests
+in the SKIP block so the # of tests run will match up with your plan.
 
-Tests are skipped when you B<never> expect them to B<ever> pass.  Like
-an optional module is not installed or the operating system doesn't
-have some feature (like fork() or symlinks) or maybe you need an
-Internet connection and one isn't available.
+It's perfectly safe to nest SKIP blocks.  Each SKIP block must have
+the label C<SKIP>, or Test::More can't work its magic.
 
 You don't skip tests which are failing because there's a bug in your
-program.  For that you use TODO.  Read on.
-
-
-=for _Future
-See L</Why are skip and todo so weird?>
+program, or for which you don't yet have code written.  For that you
+use TODO.  Read on.
 
 =cut
 
@@ -832,6 +840,8 @@ With a todo block, the tests inside are expected to fail.  Test::More
 will run the tests normally, but print out special flags indicating
 they are "todo".  Test::Harness will interpret failures as being ok.
 Should anything succeed, it will report it as an unexpected success.
+You then know the thing you had todo is done and can remove the
+TODO flag.
 
 The nice part about todo tests, as opposed to simply commenting out a
 block of tests, is it's like having a programmatic todo list.  You know
@@ -880,6 +890,17 @@ sub todo_skip {
     last TODO;
 }
 
+=item When do I use SKIP vs. TODO?
+
+B<If it's something the user might not be able to do>, use SKIP.
+This includes optional modules that aren't installed, running under
+an OS that doesn't have some feature (like fork() or symlinks), or maybe
+you need an Internet connection and one isn't available.
+
+B<If it's something the programmer hasn't done yet>, use TODO.  This
+is for any code you haven't written yet, or bugs you have yet to fix,
+but want to put tests in your testing script (always a good idea).
+
 
 =back
 
@@ -1139,6 +1160,8 @@ sub builder {
 
 Test::More is B<explicitly> tested all the way back to perl 5.004.
 
+Test::More is thread-safe for perl 5.8.0 and up.
+
 =head1 BUGS and CAVEATS
 
 =over 4
diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm
index ee59bd30c0..464fffd782 100644
--- a/lib/Test/Simple.pm
+++ b/lib/Test/Simple.pm
@@ -4,7 +4,7 @@ use 5.004;
 
 use strict 'vars';
 use vars qw($VERSION);
-$VERSION = '0.44';
+$VERSION = '0.45';
 
 
 use Test::Builder;
@@ -171,6 +171,7 @@ Unfortunately, I can't differentiate any further.
 
 Test::Simple is B<explicitly> tested all the way back to perl 5.004.
 
+Test::Simple is thread-safe in perl 5.8.0 and up.
 
 =head1 HISTORY
 
diff --git a/lib/Test/Simple/Changes b/lib/Test/Simple/Changes
index 38cbb48821..0591a7e435 100644
--- a/lib/Test/Simple/Changes
+++ b/lib/Test/Simple/Changes
@@ -1,5 +1,13 @@
 Revision history for Perl extension Test::Simple
 
+0.45  Wed Jun 19 18:41:12 EDT 2002
+    - Andy Lester made the SKIP & TODO docs a bit clearer.
+    - Explicitly disallowing double plans. (RT #553)
+    - Kicking up the minimum version of Test::Harness to one that's
+      fairly bug free.
+    - Made clear a common problem with use_ok and BEGIN blocks.
+    - Arthur Bergman made Test::Builder thread-safe.
+
 0.44  Thu Apr 25 00:27:27 EDT 2002
     - names containing newlines no longer produce confusing output
       (from chromatic)
diff --git a/lib/Test/Simple/t/Builder.t b/lib/Test/Simple/t/Builder.t
index e10252e9df..a5bfd155a6 100644
--- a/lib/Test/Simple/t/Builder.t
+++ b/lib/Test/Simple/t/Builder.t
@@ -10,7 +10,7 @@ BEGIN {
 use Test::Builder;
 my $Test = Test::Builder->new;
 
-$Test->plan( tests => 9 );
+$Test->plan( tests => 7 );
 
 my $default_lvl = $Test->level;
 $Test->level(0);
@@ -28,9 +28,3 @@ $Test->current_test( $test_num );
 print "ok $test_num - current_test() set\n";
 
 $Test->ok( 1, 'counter still good' );
-
-eval { $Test->plan(7); };
-$Test->like( $@, q{/^plan\(\) doesn't understand 7/}, 'bad plan()' );
-
-eval { $Test->plan(wibble => 7); };
-$Test->like( $@, q{/^plan\(\) doesn't understand wibble 7/}, 'bad plan()' );
diff --git a/lib/Test/Simple/t/bad_plan.t b/lib/Test/Simple/t/bad_plan.t
new file mode 100644
index 0000000000..442fee86f0
--- /dev/null
+++ b/lib/Test/Simple/t/bad_plan.t
@@ -0,0 +1,38 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+my $test_num = 1;
+# Utility testing functions.
+sub ok ($;$) {
+    my($test, $name) = @_;
+    my $ok = '';
+    $ok .= "not " unless $test;
+    $ok .= "ok $test_num";
+    $ok .= " - $name" if defined $name;
+    $ok .= "\n";
+    print $ok;
+    $test_num++;
+
+    return $test;
+}
+
+
+use Test::Builder;
+my $Test = Test::Builder->new;
+
+print "1..2\n";
+
+eval { $Test->plan(7); };
+ok( $@ =~ /^plan\(\) doesn't understand 7/, 'bad plan()' ) ||
+    print STDERR "# $@";
+
+eval { $Test->plan(wibble => 7); };
+ok( $@ =~ /^plan\(\) doesn't understand wibble 7/, 'bad plan()' ) ||
+    print STDERR "# $@";
+
diff --git a/lib/Test/Simple/t/plan.t b/lib/Test/Simple/t/plan.t
index a7b26246a7..c2bf27a37e 100644
--- a/lib/Test/Simple/t/plan.t
+++ b/lib/Test/Simple/t/plan.t
@@ -7,7 +7,11 @@ BEGIN {
 
 use Test::More;
 
-plan tests => 2;
+plan tests => 4;
+eval { plan tests => 4 };
+like( $@, '/^You tried to plan twice!/',    'disallow double plan' );
+eval { plan 'no_plan'  };
+like( $@, '/^You tried to plan twice!/',    'disallow chaning plan' );
 
 pass('Just testing plan()');
 pass('Testing it some more');
diff --git a/lib/Test/Simple/t/threads.t b/lib/Test/Simple/t/threads.t
new file mode 100644
index 0000000000..4212cccb77
--- /dev/null
+++ b/lib/Test/Simple/t/threads.t
@@ -0,0 +1,30 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use Config;
+unless ($Config{'useithreads'}) {
+    print "1..0 # Skip: no threads\n";
+    exit 0;
+}
+
+use strict;
+require threads;
+use Test::Builder;
+
+my $Test = Test::Builder->new;
+$Test->exported_to('main');
+$Test->plan(tests => 6);
+
+for(1..5) {
+	'threads'->create(sub { 
+          $Test->ok(1,"Each of these should app the test number") 
+    })->join;
+}
+
+$Test->is_num($Test->current_test(), 5,"Should be five");