Upgrade to Test-Simple-0.75
authorSteve Peters <steve@fisharerojo.org>
Fri, 29 Feb 2008 03:10:59 +0000 (03:10 +0000)
committerSteve Peters <steve@fisharerojo.org>
Fri, 29 Feb 2008 03:10:59 +0000 (03:10 +0000)
p4raw-id: //depot/perl@33391

MANIFEST
lib/Test/Builder.pm
lib/Test/Builder/Module.pm
lib/Test/Builder/Tester.pm
lib/Test/More.pm
lib/Test/Simple.pm
lib/Test/Simple/t/BEGIN_require_ok.t [new file with mode: 0644]
lib/Test/Simple/t/is_deeply_with_threads.t
lib/Test/Simple/t/todo.t

index 469c9c1..2813550 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2696,6 +2696,7 @@ lib/Test/Simple/README            Test::Simple README
 lib/Test/Simple/t/00test_harness_check.t       Test::Simple test
 lib/Test/Simple/t/bad_plan.t   Test::Builder plan() test
 lib/Test/Simple/t/bail_out.t   Test::Builder BAIL_OUT test
+lib/Test/Simple/t/BEGIN_require_ok.t   Test::More require_ok() testing
 lib/Test/Simple/t/BEGIN_use_ok.t       Test::More use_ok() testing
 lib/Test/Simple/t/buffer.t     Test::Builder buffering test
 lib/Test/Simple/t/Builder.t    Test::Builder tests
index c385452..b2bb376 100644 (file)
@@ -198,7 +198,7 @@ sub reset {
 
     $self->_dup_stdhandles unless $^C;
 
-    return undef;
+    return;
 }
 
 =back
@@ -401,9 +401,7 @@ sub ok {
     Very confusing.
 ERR
 
-    my($pack, $file, $line) = $self->caller;
-
-    my $todo = $self->todo($pack);
+    my $todo = $self->todo();
     $self->_unoverload_str(\$todo);
 
     my $out;
@@ -448,13 +446,14 @@ ERR
         my $msg = $todo ? "Failed (TODO)" : "Failed";
         $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
 
-       if( defined $name ) {
-           $self->diag(qq[  $msg test '$name'\n]);
-           $self->diag(qq[  at $file line $line.\n]);
-       }
-       else {
-           $self->diag(qq[  $msg test at $file line $line.\n]);
-       }
+    my(undef, $file, $line) = $self->caller;
+        if( defined $name ) {
+            $self->diag(qq[  $msg test '$name'\n]);
+            $self->diag(qq[  at $file line $line.\n]);
+        }
+        else {
+            $self->diag(qq[  $msg test at $file line $line.\n]);
+        }
     } 
 
     return $test ? 1 : 0;
@@ -705,7 +704,8 @@ sub cmp_ok {
 
         my $code = $self->_caller_context;
 
-        # Yes, it has to look like this or 5.4.5 won't see the #line directive.
+        # Yes, it has to look like this or 5.4.5 won't see the #line 
+        # directive.
         # Don't ask me, man, I just work here.
         $test = eval "
 $code" . "\$got $type \$expect;";
@@ -960,7 +960,8 @@ sub _regex_ok {
 
         local($@, $!, $SIG{__DIE__}); # isolate eval
 
-        # Yes, it has to look like this or 5.4.5 won't see the #line directive.
+        # Yes, it has to look like this or 5.4.5 won't see the #line 
+        # directive.
         # Don't ask me, man, I just work here.
         $test = eval "
 $code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
@@ -1149,7 +1150,7 @@ foreach my $attribute (qw(No_Header No_Ending No_Diag)) {
         return $self->{$attribute};
     };
 
-    no strict 'refs';
+    no strict 'refs';   ## no critic
     *{__PACKAGE__.'::'.$method} = $code;
 }
 
@@ -1336,10 +1337,9 @@ sub _new_fh {
         $fh = $file_or_fh;
     }
     else {
-        $fh = do { local *FH };
-        open $fh, ">$file_or_fh" or
+        open $fh, ">", $file_or_fh or
             $self->croak("Can't open test output log $file_or_fh: $!");
-       _autoflush($fh);
+        _autoflush($fh);
     }
 
     return $fh;
@@ -1578,7 +1578,7 @@ sub todo {
     $pack = $pack || $self->exported_to || $self->caller($Level);
     return 0 unless $pack;
 
-    no strict 'refs';
+    no strict 'refs';   ## no critic
     return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
                                      : 0;
 }
index 7fa0a5c..82d19c6 100644 (file)
@@ -1,13 +1,13 @@
 package Test::Builder::Module;
 
+use strict;
+
 use Test::Builder;
 
 require Exporter;
-@ISA = qw(Exporter);
+our @ISA = qw(Exporter);
 
-$VERSION = '0.74';
-
-use strict;
+our $VERSION = '0.75';
 
 # 5.004's Exporter doesn't have export_to_level.
 my $_export_to_level = sub {
index 487b16d..ef66d66 100644 (file)
@@ -1,8 +1,7 @@
 package Test::Builder::Tester;
 
 use strict;
-use vars qw(@EXPORT $VERSION @ISA);
-$VERSION = "1.11";
+our $VERSION = "1.12";
 
 use Test::Builder;
 use Symbol;
@@ -56,9 +55,9 @@ my $t = Test::Builder->new;
 ###
 
 use Exporter;
-@ISA = qw(Exporter);
+our @ISA = qw(Exporter);
 
-@EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
+our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
 
 # _export_to_level and import stolen directly from Test::More.  I am
 # the king of cargo cult programming ;-)
@@ -188,7 +187,7 @@ output filehandles)
 
 =cut
 
-sub test_out(@)
+sub test_out
 {
     # do we need to do any setup?
     _start_testing() unless $testing;
@@ -196,7 +195,7 @@ sub test_out(@)
     $out->expect(@_)
 }
 
-sub test_err(@)
+sub test_err
 {
     # do we need to do any setup?
     _start_testing() unless $testing;
@@ -549,36 +548,36 @@ sub complaint
     if (Test::Builder::Tester::color)
     {
       # get color
-      eval "require Term::ANSIColor";
+      eval { require Term::ANSIColor };
       unless ($@)
       {
-       # colours
+        # colours
 
-       my $green = Term::ANSIColor::color("black").
-                   Term::ANSIColor::color("on_green");
+        my $green = Term::ANSIColor::color("black").
+                    Term::ANSIColor::color("on_green");
         my $red   = Term::ANSIColor::color("black").
                     Term::ANSIColor::color("on_red");
-       my $reset = Term::ANSIColor::color("reset");
+        my $reset = Term::ANSIColor::color("reset");
 
-       # work out where the two strings start to differ
-       my $char = 0;
-       $char++ while substr($got, $char, 1) eq substr($wanted, $char, 1);
+        # work out where the two strings start to differ
+        my $char = 0;
+        $char++ while substr($got, $char, 1) eq substr($wanted, $char, 1);
 
-       # get the start string and the two end strings
-       my $start     = $green . substr($wanted, 0,   $char);
-       my $gotend    = $red   . substr($got   , $char) . $reset;
-       my $wantedend = $red   . substr($wanted, $char) . $reset;
+        # get the start string and the two end strings
+        my $start     = $green . substr($wanted, 0,   $char);
+        my $gotend    = $red   . substr($got   , $char) . $reset;
+        my $wantedend = $red   . substr($wanted, $char) . $reset;
 
-       # make the start turn green on and off
-       $start =~ s/\n/$reset\n$green/g;
+        # make the start turn green on and off
+        $start =~ s/\n/$reset\n$green/g;
 
-       # make the ends turn red on and off
-       $gotend    =~ s/\n/$reset\n$red/g;
-       $wantedend =~ s/\n/$reset\n$red/g;
+        # make the ends turn red on and off
+        $gotend    =~ s/\n/$reset\n$red/g;
+        $wantedend =~ s/\n/$reset\n$red/g;
 
-       # rebuild the strings
-       $got    = $start . $gotend;
-       $wanted = $start . $wantedend;
+        # rebuild the strings
+        $got    = $start . $gotend;
+        $wanted = $start . $wantedend;
       }
     }
 
index abdd55e..a33be4c 100644 (file)
@@ -1,7 +1,6 @@
 package Test::More;
 
-use 5.004;
-
+use 5.006;
 use strict;
 
 
@@ -16,7 +15,7 @@ sub _carp {
 
 
 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.74';
+$VERSION = '0.75';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 use Test::Builder::Module;
@@ -659,30 +658,28 @@ sub use_ok ($;@) {
 
     my($pack,$filename,$line) = caller;
 
-    # Work around a glitch in $@ and eval
-    my $eval_error;
-    {
-        local($@,$!,$SIG{__DIE__});   # isolate eval
-
-        if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
-            # probably a version check.  Perl needs to see the bare number
-            # for it to work with non-Exporter based modules.
-            eval <<USE;
+    my $code;
+    if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
+        # probably a version check.  Perl needs to see the bare number
+        # for it to work with non-Exporter based modules.
+        $code = <<USE;
 package $pack;
 use $module $imports[0];
+1;
 USE
-        }
-        else {
-            eval <<USE;
+    }
+    else {
+        $code = <<USE;
 package $pack;
-use $module \@imports;
+use $module \@{\$args[0]};
+1;
 USE
-        }
-        $eval_error = $@;
     }
 
-    my $ok = $tb->ok( !$eval_error, "use $module;" );
 
+    my($eval_result, $eval_error) = _eval($code, \@imports);
+    my $ok = $tb->ok( $eval_result, "use $module;" );
+    
     unless( $ok ) {
         chomp $eval_error;
         $@ =~ s{^BEGIN failed--compilation aborted at .*$}
@@ -697,6 +694,20 @@ DIAGNOSTIC
     return $ok;
 }
 
+
+sub _eval {
+    my($code) = shift;
+    my @args = @_;
+
+    # Work around oddities surrounding resetting of $@ by immediately
+    # storing it.
+    local($@,$!,$SIG{__DIE__});   # isolate eval
+    my $eval_result = eval $code;
+    my $eval_error  = $@;
+
+    return($eval_result, $eval_error);
+}
+
 =item B<require_ok>
 
    require_ok($module);
@@ -716,20 +727,20 @@ sub require_ok ($) {
     # Module names must be barewords, files not.
     $module = qq['$module'] unless _is_module_name($module);
 
-    local($!, $@, $SIG{__DIE__}); # isolate eval
-    local $SIG{__DIE__};
-    eval <<REQUIRE;
+    my $code = <<REQUIRE;
 package $pack;
 require $module;
+1;
 REQUIRE
 
-    my $ok = $tb->ok( !$@, "require $module;" );
+    my($eval_result, $eval_error) = _eval($code);
+    my $ok = $tb->ok( $eval_result, "require $module;" );
 
     unless( $ok ) {
-        chomp $@;
+        chomp $eval_error;
         $tb->diag(<<DIAGNOSTIC);
     Tried to require '$module'.
-    Error:  $@
+    Error:  $eval_error
 DIAGNOSTIC
 
     }
@@ -1443,7 +1454,7 @@ B<NOTE>  This behavior may go away in future versions.
 
 =item Backwards compatibility
 
-Test::More works with Perls as old as 5.004_05.
+Test::More works with Perls as old as 5.6.0.
 
 
 =item Overloaded objects
index 1b7e0a7..a070133 100644 (file)
@@ -4,7 +4,7 @@ use 5.004;
 
 use strict 'vars';
 use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.74';
+$VERSION = '0.75';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 use Test::Builder::Module;
diff --git a/lib/Test/Simple/t/BEGIN_require_ok.t b/lib/Test/Simple/t/BEGIN_require_ok.t
new file mode 100644 (file)
index 0000000..289ebc5
--- /dev/null
@@ -0,0 +1,24 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use Test::More;
+
+my $result;
+BEGIN {
+    eval {
+        require_ok("Wibble");
+    };
+    $result = $@;
+}
+
+plan tests => 1;
+like $result, '/^You tried to run a test without a plan/';
index a9e2e5a..cf6b6ba 100644 (file)
@@ -22,12 +22,17 @@ BEGIN {
         print "1..0 # Skip: no working threads\n";
         exit 0;
     }
+    
+    unless ( $ENV{AUTHOR_TESTING} ) {
+        print "1..0 # Skip: many perls have broken threads\n";
+        exit 0;
+    }
 }
 use Test::More;
 
 my $Num_Threads = 5;
 
-plan tests => $Num_Threads * 100 + 5;
+plan tests => $Num_Threads * 100 + 6;
 
 
 sub do_one_thread {
@@ -56,3 +61,5 @@ for my $t (@kids) {
     my $rc = $t->join();
     cmp_ok( $rc, '==', 42, "threads exit status is $rc" );
 }
+
+pass("End of test");
index 3e5ad02..6ea51a6 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
 
 use Test::More;
 
-plan tests => 18;
+plan tests => 19;
 
 
 $Why = 'Just testing the todo interface.';
@@ -77,3 +77,13 @@ TODO: {
                   "block at $0 line 82\n",
         'todo_skip without $how_many warning' );
 }
+
+
+{
+    Test::More->builder->exported_to("Wibble");
+    $Wibble::TODO = '';     # shut up used only once warning
+    TODO: {
+        local $Wibble::TODO = $Why;
+        fail("TODO honors exported_to()");
+    }
+}
\ No newline at end of file