Upgrade to Test::Simple 0.61
Rafael Garcia-Suarez [Mon, 26 Sep 2005 16:31:43 +0000 (16:31 +0000)]
p4raw-id: //depot/perl@25604

28 files changed:
MANIFEST
lib/Test/Builder.pm
lib/Test/Builder/Module.pm [new file with mode: 0644]
lib/Test/More.pm
lib/Test/Simple.pm
lib/Test/Simple/Changes
lib/Test/Simple/t/00test_harness_check.t
lib/Test/Simple/t/bail_out.t [new file with mode: 0644]
lib/Test/Simple/t/create.t
lib/Test/Simple/t/eq_set.t
lib/Test/Simple/t/exit.t
lib/Test/Simple/t/extra.t
lib/Test/Simple/t/extra_one.t
lib/Test/Simple/t/fail-like.t
lib/Test/Simple/t/fail-more.t
lib/Test/Simple/t/fail.t
lib/Test/Simple/t/fail_one.t
lib/Test/Simple/t/harness_active.t
lib/Test/Simple/t/has_plan2.t
lib/Test/Simple/t/is_deeply_fail.t
lib/Test/Simple/t/missing.t
lib/Test/Simple/t/no_diag.t
lib/Test/Simple/t/overload.t
lib/Test/Simple/t/plan_no_plan.t
lib/Test/Simple/t/todo.t
lib/Test/Simple/t/undef.t
t/lib/Test/Simple/sample_tests/too_few.plx
t/lib/Test/Simple/sample_tests/too_few_fail.plx [new file with mode: 0644]

index 36f94d8..755e4b3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1926,6 +1926,7 @@ lib/Term/Complete.t               See if Term::Complete works
 lib/Term/ReadLine.pm           Stub readline library
 lib/Term/ReadLine.t            See if Term::ReadLine works
 lib/Test/Builder.pm            For writing new test libraries
+lib/Test/Builder/Module.pm     Base class for test modules
 lib/Test/Harness/Assert.pm     Test::Harness::Assert (internal use only)
 lib/Test/Harness/bin/prove     The prove harness utility
 lib/Test/Harness/Changes       Test::Harness
@@ -1959,6 +1960,7 @@ lib/Test/Simple.pm                Basic utility for writing tests
 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/buffer.t     Test::Builder buffering test
 lib/Test/Simple/t/Builder.t    Test::Builder tests
 lib/Test/Simple/t/circular_data.t      Test::Simple test
@@ -2772,6 +2774,7 @@ t/lib/Test/Simple/sample_tests/pre_plan_death.plx         for exit.t
 t/lib/Test/Simple/sample_tests/require.plx             for exit.t
 t/lib/Test/Simple/sample_tests/success.plx             for exit.t
 t/lib/Test/Simple/sample_tests/too_few.plx             for exit.t
+t/lib/Test/Simple/sample_tests/too_few_fail.plx                for exit.t
 t/lib/Test/Simple/sample_tests/two_fail.plx            for exit.t
 t/lib/TieIn.pm                 Testing library for dummy input handles
 t/lib/TieOut.pm                        Testing library to capture prints
index 859915b..b107633 100644 (file)
@@ -8,7 +8,7 @@ $^C ||= 0;
 
 use strict;
 use vars qw($VERSION);
-$VERSION = '0.30';
+$VERSION = '0.31';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 # Make Test::Builder thread-safe for ithreads.
@@ -395,7 +395,7 @@ sub ok {
     $self->{Curr_Test}++;
 
     # In case $name is a string overloaded object, force it to stringify.
-    $self->_unoverload(\$name);
+    $self->_unoverload_str(\$name);
 
     $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
     You named your test '$name'.  You shouldn't use numbers for your test names.
@@ -405,7 +405,7 @@ ERR
     my($pack, $file, $line) = $self->caller;
 
     my $todo = $self->todo($pack);
-    $self->_unoverload(\$todo);
+    $self->_unoverload_str(\$todo);
 
     my $out;
     my $result = &share({});
@@ -448,7 +448,14 @@ ERR
     unless( $test ) {
         my $msg = $todo ? "Failed (TODO)" : "Failed";
         $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
-        $self->diag("    $msg test ($file at line $line)\n");
+
+       if( defined $name ) {
+           $self->diag(qq[  $msg test '$name'\n]);
+           $self->diag(qq[  in $file at line $line.\n]);
+       }
+       else {
+           $self->diag(qq[  $msg test in $file at line $line.\n]);
+       }
     } 
 
     return $test ? 1 : 0;
@@ -457,6 +464,7 @@ ERR
 
 sub _unoverload {
     my $self  = shift;
+    my $type  = shift;
 
     local($@,$!);
 
@@ -464,8 +472,8 @@ sub _unoverload {
 
     foreach my $thing (@_) {
         eval { 
-            if( defined $$thing ) {
-                if( my $string_meth = overload::Method($$thing, '""') ) {
+            if( _is_object($$thing) ) {
+                if( my $string_meth = overload::Method($$thing, $type) ) {
                     $$thing = $$thing->$string_meth();
                 }
             }
@@ -474,6 +482,42 @@ sub _unoverload {
 }
 
 
+sub _is_object {
+    my $thing = shift;
+
+    return eval { ref $thing && $thing->isa('UNIVERSAL') } ? 1 : 0;
+}
+
+
+sub _unoverload_str {
+    my $self = shift;
+
+    $self->_unoverload(q[""], @_);
+}    
+
+sub _unoverload_num {
+    my $self = shift;
+
+    $self->_unoverload('0+', @_);
+
+    for my $val (@_) {
+        next unless $self->_is_dualvar($$val);
+        $$val = $$val+0;
+    }
+}
+
+
+# This is a hack to detect a dualvar such as $!
+sub _is_dualvar {
+    my($self, $val) = @_;
+
+    local $^W = 0;
+    my $numval = $val+0;
+    return 1 if $numval != 0 and $numval ne $val;
+}
+
+
+
 =item B<is_eq>
 
   $Test->is_eq($got, $expected, $name);
@@ -494,6 +538,8 @@ sub is_eq {
     my($self, $got, $expect, $name) = @_;
     local $Level = $Level + 1;
 
+    $self->_unoverload_str(\$got, \$expect);
+
     if( !defined $got || !defined $expect ) {
         # undef only matches undef and nothing else
         my $test = !defined $got && !defined $expect;
@@ -510,6 +556,8 @@ sub is_num {
     my($self, $got, $expect, $name) = @_;
     local $Level = $Level + 1;
 
+    $self->_unoverload_num(\$got, \$expect);
+
     if( !defined $got || !defined $expect ) {
         # undef only matches undef and nothing else
         my $test = !defined $got && !defined $expect;
@@ -533,7 +581,7 @@ sub _is_diag {
             }
             else {
                 # force numeric context
-                $$val = $$val+0;
+                $self->_unoverload_num($val);
             }
         }
         else {
@@ -684,8 +732,6 @@ sub maybe_regex {
 sub _regex_ok {
     my($self, $this, $regex, $cmp, $name) = @_;
 
-    local $Level = $Level + 1;
-
     my $ok = 0;
     my $usable_regex = $self->maybe_regex($regex);
     unless (defined $usable_regex) {
@@ -695,9 +741,19 @@ sub _regex_ok {
     }
 
     {
-        local $^W = 0;
-        my $test = $this =~ /$usable_regex/ ? 1 : 0;
+        my $test;
+        my $code = $self->_caller_context;
+
+        local($@, $!);
+
+        # 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};
+
         $test = !$test if $cmp eq '!~';
+
+        local $Level = $Level + 1;
         $ok = $self->ok( $test, $name );
     }
 
@@ -724,15 +780,33 @@ Works just like Test::More's cmp_ok().
 
 =cut
 
+
+my %numeric_cmps = map { ($_, 1) } 
+                       ("<",  "<=", ">",  ">=", "==", "!=", "<=>");
+
 sub cmp_ok {
     my($self, $got, $type, $expect, $name) = @_;
 
+    # Treat overloaded objects as numbers if we're asked to do a
+    # numeric comparison.
+    my $unoverload = $numeric_cmps{$type} ? '_unoverload_num'
+                                          : '_unoverload_str';
+
+    $self->$unoverload(\$got, \$expect);
+
+
     my $test;
     {
-        local $^W = 0;
         local($@,$!);   # don't interfere with $@
                         # eval() sometimes resets $!
-        $test = eval "\$got $type \$expect";
+
+        my $code = $self->_caller_context;
+
+        # 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;";
+
     }
     local $Level = $Level + 1;
     my $ok = $self->ok($test, $name);
@@ -760,9 +834,22 @@ sub _cmp_diag {
 DIAGNOSTIC
 }
 
-=item B<BAILOUT>
 
-    $Test->BAILOUT($reason);
+sub _caller_context {
+    my $self = shift;
+
+    my($pack, $file, $line) = $self->caller(1);
+
+    my $code = '';
+    $code .= "#line $line $file\n" if defined $file and defined $line;
+
+    return $code;
+}
+
+
+=item B<BAIL_OUT>
+
+    $Test->BAIL_OUT($reason);
 
 Indicates to the Test::Harness that things are going so badly all
 testing should terminate.  This includes running any additional test
@@ -772,13 +859,20 @@ It will exit with 255.
 
 =cut
 
-sub BAILOUT {
+sub BAIL_OUT {
     my($self, $reason) = @_;
 
+    $self->{Bailed_Out} = 1;
     $self->_print("Bail out!  $reason");
     exit 255;
 }
 
+=for deprecated
+BAIL_OUT() used to be BAILOUT()
+
+*BAILOUT = \&BAIL_OUT;
+
+
 =item B<skip>
 
     $Test->skip;
@@ -791,7 +885,7 @@ Skips the current test, reporting $why.
 sub skip {
     my($self, $why) = @_;
     $why ||= '';
-    $self->_unoverload(\$why);
+    $self->_unoverload_str(\$why);
 
     unless( $self->{Have_Plan} ) {
         require Carp;
@@ -948,11 +1042,13 @@ sub use_numbers {
     return $self->{Use_Nums};
 }
 
-=item B<no_header>
 
-    $Test->no_header($no_header);
+=item B<no_diag>
 
-If set to true, no "1..N" header will be printed.
+    $Test->no_diag($no_diag);
+
+If set true no diagnostics will be printed.  This includes calls to
+diag().
 
 =item B<no_ending>
 
@@ -963,24 +1059,28 @@ ends.  It also changes the exit code as described below.
 
 If this is true, none of that will be done.
 
+=item B<no_header>
+
+    $Test->no_header($no_header);
+
+If set to true, no "1..N" header will be printed.
+
 =cut
 
-sub no_header {
-    my($self, $no_header) = @_;
+foreach my $attribute (qw(No_Header No_Ending No_Diag)) {
+    my $method = lc $attribute;
 
-    if( defined $no_header ) {
-        $self->{No_Header} = $no_header;
-    }
-    return $self->{No_Header};
-}
+    my $code = sub {
+        my($self, $no) = @_;
 
-sub no_ending {
-    my($self, $no_ending) = @_;
+        if( defined $no ) {
+            $self->{$attribute} = $no;
+        }
+        return $self->{$attribute};
+    };
 
-    if( defined $no_ending ) {
-        $self->{No_Ending} = $no_ending;
-    }
-    return $self->{No_Ending};
+    no strict 'refs';
+    *{__PACKAGE__.'::'.$method} = $code;
 }
 
 
@@ -1023,6 +1123,8 @@ Mark Fowler <mark@twoshortplanks.com>
 
 sub diag {
     my($self, @msgs) = @_;
+
+    return if $self->no_diag;
     return unless @msgs;
 
     # Prevent printing headers when compiling (i.e. -c)
@@ -1172,6 +1274,7 @@ sub _new_fh {
 
 sub _is_fh {
     my $maybe_fh = shift;
+    return 0 unless defined $maybe_fh;
 
     return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
 
@@ -1490,8 +1593,11 @@ sub _ending {
     # should do the ending.
     # Exit if plan() was never called.  This is so "require Test::Simple" 
     # doesn't puke.
-    if( ($self->{Original_Pid} != $$) or
-       (!$self->{Have_Plan} && !$self->{Test_Died}) )
+    # Don't do an ending if we bailed out.
+    if( ($self->{Original_Pid} != $$)                  or
+       (!$self->{Have_Plan} && !$self->{Test_Died})    or
+       $self->{Bailed_Out}
+      )
     {
        _my_exit($?);
        return;
@@ -1516,26 +1622,31 @@ sub _ending {
         }
 
         my $num_failed = grep !$_->{'ok'}, 
-                              @{$test_results}[0..$self->{Expected_Tests}-1];
-        $num_failed += abs($self->{Expected_Tests} - @$test_results);
+                              @{$test_results}[0..$self->{Curr_Test}-1];
 
-        if( $self->{Curr_Test} < $self->{Expected_Tests} ) {
+        my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests};
+
+        if( $num_extra < 0 ) {
             my $s = $self->{Expected_Tests} == 1 ? '' : 's';
             $self->diag(<<"FAIL");
 Looks like you planned $self->{Expected_Tests} test$s but only ran $self->{Curr_Test}.
 FAIL
         }
-        elsif( $self->{Curr_Test} > $self->{Expected_Tests} ) {
-            my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests};
+        elsif( $num_extra > 0 ) {
             my $s = $self->{Expected_Tests} == 1 ? '' : 's';
             $self->diag(<<"FAIL");
 Looks like you planned $self->{Expected_Tests} test$s but ran $num_extra extra.
 FAIL
         }
-        elsif ( $num_failed ) {
+
+        if ( $num_failed ) {
+            my $num_tests = $self->{Curr_Test};
             my $s = $num_failed == 1 ? '' : 's';
+
+            my $qualifier = $num_extra == 0 ? '' : ' run';
+
             $self->diag(<<"FAIL");
-Looks like you failed $num_failed test$s of $self->{Expected_Tests}.
+Looks like you failed $num_failed test$s of $num_tests$qualifier.
 FAIL
         }
 
@@ -1547,7 +1658,18 @@ FAIL
             _my_exit( 255 ) && return;
         }
 
-        _my_exit( $num_failed <= 254 ? $num_failed : 254  ) && return;
+        my $exit_code;
+        if( $num_failed ) {
+            $exit_code = $num_failed <= 254 ? $num_failed : 254;
+        }
+        elsif( $num_extra != 0 ) {
+            $exit_code = 255;
+        }
+        else {
+            $exit_code = 0;
+        }
+
+        _my_exit( $exit_code ) && return;
     }
     elsif ( $self->{Skip_All} ) {
         _my_exit( 0 ) && return;
@@ -1581,7 +1703,7 @@ considered a failure and will exit with 255.
 So the exit codes are...
 
     0                   all tests successful
-    255                 test died
+    255                 test died or all passed but wrong # of tests run
     any other number    how many failed (including missing or extras)
 
 If you fail more than 254 tests, it will be reported as 254.
diff --git a/lib/Test/Builder/Module.pm b/lib/Test/Builder/Module.pm
new file mode 100644 (file)
index 0000000..b3ccce6
--- /dev/null
@@ -0,0 +1,182 @@
+package Test::Builder::Module;
+
+use Test::Builder;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+$VERSION = '0.02';
+
+use strict;
+
+# 5.004's Exporter doesn't have export_to_level.
+my $_export_to_level = sub {
+      my $pkg = shift;
+      my $level = shift;
+      (undef) = shift;                  # redundant arg
+      my $callpkg = caller($level);
+      $pkg->export($callpkg, @_);
+};
+
+
+=head1 NAME
+
+Test::Builder::Module - Base class for test modules
+
+=head1 SYNOPSIS
+
+  # Emulates Test::Simple
+  package Your::Module;
+
+  my $CLASS = __PACKAGE__;
+
+  use base 'Test::Builder::Module';
+  @EXPORT = qw(ok);
+
+  sub ok ($;$) {
+      my $tb = $CLASS->builder;
+      return $tb->ok(@_);
+  }
+  
+  1;
+
+
+=head1 DESCRIPTION
+
+This is a superclass for Test::Builder-based modules.  It provides a
+handful of common functionality and a method of getting at the underlying
+Test::Builder object.
+
+
+=head2 Importing
+
+Test::Builder::Module is a subclass of Exporter which means your
+module is also a subclass of Exporter.  @EXPORT, @EXPORT_OK, etc...
+all act normally.
+
+A few methods are provided to do the C<use Your::Module tests => 23> part
+for you.
+
+=head3 import
+
+Test::Builder::Module provides an import() method which acts in the
+same basic way as Test::More's, setting the plan and controling
+exporting of functions and variables.  This allows your module to set
+the plan independent of Test::More.
+
+All arguments passed to import() are passed onto 
+C<< Your::Module->builder->plan() >> with the exception of 
+C<import =>[qw(things to import)]>.
+
+    use Your::Module import => [qw(this that)], tests => 23;
+
+says to import the functions this() and that() as well as set the plan
+to be 23 tests.
+
+import() also sets the exported_to() attribute of your builder to be
+the caller of the import() function.
+
+Additional behaviors can be added to your import() method by overriding
+import_extra().
+
+=cut
+
+sub import {
+    my($class) = shift;
+
+    my $test = $class->builder;
+
+    my $caller = caller;
+
+    $test->exported_to($caller);
+
+    $class->import_extra(\@_);
+    my(@imports) = $class->_strip_imports(\@_);
+
+    $test->plan(@_);
+
+    $class->$_export_to_level(1, $class, @imports);
+}
+
+
+sub _strip_imports {
+    my $class = shift;
+    my $list  = shift;
+
+    my @imports = ();
+    my @other   = ();
+    my $idx = 0;
+    while( $idx <= $#{$list} ) {
+        my $item = $list->[$idx];
+
+        if( defined $item and $item eq 'import' ) {
+            push @imports, @{$list->[$idx+1]};
+            $idx++;
+        }
+        else {
+            push @other, $item;
+        }
+
+        $idx++;
+    }
+
+    @$list = @other;
+
+    return @imports;
+}
+
+
+=head3 import_extra
+
+    Your::Module->import_extra(\@import_args);
+
+import_extra() is called by import().  It provides an opportunity for you
+to add behaviors to your module based on its import list.
+
+Any extra arguments which shouldn't be passed on to plan() should be 
+stripped off by this method.
+
+See Test::More for an example of its use.
+
+B<NOTE> This mechanism is I<VERY ALPHA AND LIKELY TO CHANGE> as it
+feels like a bit of an ugly hack in its current form.
+
+=cut
+
+sub import_extra {}
+
+
+=head2 Builder
+
+Test::Builder::Module provides some methods of getting at the underlying
+Test::Builder object.
+
+=head3 builder
+
+  my $builder = Your::Class->builder;
+
+This method returns the Test::Builder object associated with Your::Class.
+It is not a constructor so you can call it as often as you like.
+
+This is the preferred way to get the Test::Builder object.  You should
+I<not> get it via C<< Test::Builder->new >> as was previously
+recommended.
+
+The object returned by builder() may change at runtime so you should
+call builder() inside each function rather than store it in a global.
+
+  sub ok {
+      my $builder = Your::Class->builder;
+
+      return $builder->ok(@_);
+  }
+
+
+=cut
+
+sub builder {
+    return Test::Builder->new;
+}
+
+
+1;
index 3183a60..c305dd0 100644 (file)
@@ -3,7 +3,6 @@ package Test::More;
 use 5.004;
 
 use strict;
-use Test::Builder;
 
 
 # Can't use Carp because it might cause use_ok() to accidentally succeed
@@ -16,12 +15,12 @@ sub _carp {
 
 
 
-require Exporter;
 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.60';
+$VERSION = '0.61';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
-@ISA    = qw(Exporter);
+use Test::Builder::Module;
+@ISA    = qw(Test::Builder::Module);
 @EXPORT = qw(ok use_ok require_ok
              is isnt like unlike is_deeply
              cmp_ok
@@ -32,22 +31,9 @@ $VERSION = eval $VERSION;    # make the alpha version come out as a number
              plan
              can_ok  isa_ok
              diag
+            BAIL_OUT
             );
 
-my $Test = Test::Builder->new;
-my $Show_Diag = 1;
-
-
-# 5.004's Exporter doesn't have export_to_level.
-sub _export_to_level
-{
-      my $pkg = shift;
-      my $level = shift;
-      (undef) = shift;                  # redundant arg
-      my $callpkg = caller($level);
-      $pkg->export($callpkg, @_);
-}
-
 
 =head1 NAME
 
@@ -100,11 +86,10 @@ Test::More - yet another framework for writing test scripts
   pass($test_name);
   fail($test_name);
 
-  # UNIMPLEMENTED!!!
-  my @status = Test::More::status;
+  BAIL_OUT($why);
 
   # UNIMPLEMENTED!!!
-  BAIL_OUT($why);
+  my @status = Test::More::status;
 
 
 =head1 DESCRIPTION
@@ -137,7 +122,7 @@ have no plan.  (Try to avoid using this as it weakens your test.)
   use Test::More qw(no_plan);
 
 B<NOTE>: using no_plan requires a Test::Harness upgrade else it will
-think everything has failed.  See L<BUGS and CAVEATS>)
+think everything has failed.  See L<CAVEATS and NOTES>).
 
 In some cases, you'll want to completely skip an entire testing script.
 
@@ -172,53 +157,34 @@ or for deciding between running the tests at all:
 =cut
 
 sub plan {
-    my(@plan) = @_;
-
-    my $idx = 0;
-    my @cleaned_plan;
-    while( $idx <= $#plan ) {
-        my $item = $plan[$idx];
+    my $tb = Test::More->builder;
 
-        if( $item eq 'no_diag' ) {
-            $Show_Diag = 0;
-        }
-        else {
-            push @cleaned_plan, $item;
-        }
-
-        $idx++;
-    }
-
-    $Test->plan(@cleaned_plan);
+    $tb->plan(@_);
 }
 
-sub import {
-    my($class) = shift;
-
-    my $caller = caller;
 
-    $Test->exported_to($caller);
+# This implements "use Test::More 'no_diag'" but the behavior is
+# deprecated.
+sub import_extra {
+    my $class = shift;
+    my $list  = shift;
 
+    my @other = ();
     my $idx = 0;
-    my @plan;
-    my @imports;
-    while( $idx <= $#_ ) {
-        my $item = $_[$idx];
-
-        if( $item eq 'import' ) {
-            push @imports, @{$_[$idx+1]};
-            $idx++;
+    while( $idx <= $#{$list} ) {
+        my $item = $list->[$idx];
+
+        if( defined $item and $item eq 'no_diag' ) {
+            $class->builder->no_diag(1);
         }
         else {
-            push @plan, $item;
+            push @other, $item;
         }
 
         $idx++;
     }
 
-    plan(@plan);
-
-    __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
+    @$list = @other;
 }
 
 
@@ -283,7 +249,8 @@ but we B<very> strongly encourage its use.
 Should an ok() fail, it will produce some diagnostics:
 
     not ok 18 - sufficient mucus
-    #     Failed test 18 (foo.t at line 42)
+    #   Failed test 'sufficient mucus'
+    #   in foo.t at line 42.
 
 This is actually Test::Simple's ok() routine.
 
@@ -291,7 +258,9 @@ This is actually Test::Simple's ok() routine.
 
 sub ok ($;$) {
     my($test, $name) = @_;
-    $Test->ok($test, $name);
+    my $tb = Test::More->builder;
+
+    $tb->ok($test, $name);
 }
 
 =item B<is>
@@ -329,7 +298,8 @@ test:
 Will produce something like this:
 
     not ok 17 - Is foo the same as bar?
-    #     Failed test (foo.t at line 139)
+    #   Failed test 'Is foo the same as bar?'
+    #   in foo.t at line 139.
     #          got: 'waffle'
     #     expected: 'yarblokos'
 
@@ -354,11 +324,15 @@ function which is an alias of isnt().
 =cut
 
 sub is ($$;$) {
-    $Test->is_eq(@_);
+    my $tb = Test::More->builder;
+
+    $tb->is_eq(@_);
 }
 
 sub isnt ($$;$) {
-    $Test->isnt_eq(@_);
+    my $tb = Test::More->builder;
+
+    $tb->isnt_eq(@_);
 }
 
 *isn't = \&isnt;
@@ -395,7 +369,9 @@ diagnostics on failure.
 =cut
 
 sub like ($$;$) {
-    $Test->like(@_);
+    my $tb = Test::More->builder;
+
+    $tb->like(@_);
 }
 
 
@@ -409,7 +385,9 @@ given pattern.
 =cut
 
 sub unlike ($$;$) {
-    $Test->unlike(@_);
+    my $tb = Test::More->builder;
+
+    $tb->unlike(@_);
 }
 
 
@@ -434,7 +412,7 @@ Its advantage over ok() is when the test fails you'll know what $this
 and $that were:
 
     not ok 1
-    #     Failed test (foo.t at line 12)
+    #   Failed test in foo.t at line 12.
     #     '23'
     #         &&
     #     undef
@@ -447,7 +425,9 @@ is()'s use of C<eq> will interfere:
 =cut
 
 sub cmp_ok($$$;$) {
-    $Test->cmp_ok(@_);
+    my $tb = Test::More->builder;
+
+    $tb->cmp_ok(@_);
 }
 
 
@@ -483,10 +463,11 @@ as one test.  If you desire otherwise, use:
 sub can_ok ($@) {
     my($proto, @methods) = @_;
     my $class = ref $proto || $proto;
+    my $tb = Test::More->builder;
 
     unless( @methods ) {
-        my $ok = $Test->ok( 0, "$class->can(...)" );
-        $Test->diag('    can_ok() called with no methods');
+        my $ok = $tb->ok( 0, "$class->can(...)" );
+        $tb->diag('    can_ok() called with no methods');
         return $ok;
     }
 
@@ -501,9 +482,9 @@ sub can_ok ($@) {
     $name = @methods == 1 ? "$class->can('$methods[0]')" 
                           : "$class->can(...)";
     
-    my $ok = $Test->ok( !@nok, $name );
+    my $ok = $tb->ok( !@nok, $name );
 
-    $Test->diag(map "    $class->can('$_') failed\n", @nok);
+    $tb->diag(map "    $class->can('$_') failed\n", @nok);
 
     return $ok;
 }
@@ -539,6 +520,7 @@ you'd like them to be more specific, you can supply an $object_name
 
 sub isa_ok ($$;$) {
     my($object, $class, $obj_name) = @_;
+    my $tb = Test::More->builder;
 
     my $diag;
     $obj_name = 'The object' unless defined $obj_name;
@@ -578,11 +560,11 @@ WHOA
 
     my $ok;
     if( $diag ) {
-        $ok = $Test->ok( 0, $name );
-        $Test->diag("    $diag\n");
+        $ok = $tb->ok( 0, $name );
+        $tb->diag("    $diag\n");
     }
     else {
-        $ok = $Test->ok( 1, $name );
+        $ok = $tb->ok( 1, $name );
     }
 
     return $ok;
@@ -607,65 +589,17 @@ Use these very, very, very sparingly.
 =cut
 
 sub pass (;$) {
-    $Test->ok(1, @_);
+    my $tb = Test::More->builder;
+    $tb->ok(1, @_);
 }
 
 sub fail (;$) {
-    $Test->ok(0, @_);
+    my $tb = Test::More->builder;
+    $tb->ok(0, @_);
 }
 
 =back
 
-=head2 Diagnostics
-
-If you pick the right test function, you'll usually get a good idea of
-what went wrong when it failed.  But sometimes it doesn't work out
-that way.  So here we have ways for you to write your own diagnostic
-messages which are safer than just C<print STDERR>.
-
-=over 4
-
-=item B<diag>
-
-  diag(@diagnostic_message);
-
-Prints a diagnostic message which is guaranteed not to interfere with
-test output.  Like C<print> @diagnostic_message is simply concatenated
-together.
-
-Handy for this sort of thing:
-
-    ok( grep(/foo/, @users), "There's a foo user" ) or
-        diag("Since there's no foo, check that /etc/bar is set up right");
-
-which would produce:
-
-    not ok 42 - There's a foo user
-    #     Failed test (foo.t at line 52)
-    # Since there's no foo, check that /etc/bar is set up right.
-
-You might remember C<ok() or diag()> with the mnemonic C<open() or
-die()>.
-
-All diag()s can be made silent by passing the "no_diag" option to
-Test::More.  C<use Test::More tests => 1, 'no_diag'>.  This is useful
-if you have diagnostics for personal testing but then wish to make
-them silent for release without commenting out each individual
-statement.
-
-B<NOTE> The exact formatting of the diagnostic output is still
-changing, but it is guaranteed that whatever you throw at it it won't
-interfere with the test.
-
-=cut
-
-sub diag {
-    return unless $Show_Diag;
-    $Test->diag(@_);
-}
-
-
-=back
 
 =head2 Module tests
 
@@ -718,6 +652,7 @@ because the notion of "compile-time" is relative.  Instead, you want:
 sub use_ok ($;@) {
     my($module, @imports) = @_;
     @imports = () unless @imports;
+    my $tb = Test::More->builder;
 
     my($pack,$filename,$line) = caller;
 
@@ -738,13 +673,13 @@ use $module \@imports;
 USE
     }
 
-    my $ok = $Test->ok( !$@, "use $module;" );
+    my $ok = $tb->ok( !$@, "use $module;" );
 
     unless( $ok ) {
         chomp $@;
         $@ =~ s{^BEGIN failed--compilation aborted at .*$}
                 {BEGIN failed--compilation aborted at $filename line $line.}m;
-        $Test->diag(<<DIAGNOSTIC);
+        $tb->diag(<<DIAGNOSTIC);
     Tried to use '$module'.
     Error:  $@
 DIAGNOSTIC
@@ -765,6 +700,7 @@ Like use_ok(), except it requires the $module or $file.
 
 sub require_ok ($) {
     my($module) = shift;
+    my $tb = Test::More->builder;
 
     my $pack = caller;
 
@@ -778,11 +714,11 @@ package $pack;
 require $module;
 REQUIRE
 
-    my $ok = $Test->ok( !$@, "require $module;" );
+    my $ok = $tb->ok( !$@, "require $module;" );
 
     unless( $ok ) {
         chomp $@;
-        $Test->diag(<<DIAGNOSTIC);
+        $tb->diag(<<DIAGNOSTIC);
     Tried to require '$module'.
     Error:  $@
 DIAGNOSTIC
@@ -805,6 +741,185 @@ sub _is_module_name {
 
 =back
 
+
+=head2 Complex data structures
+
+Not everything is a simple eq check or regex.  There are times you
+need to see if two data structures are equivalent.  For these
+instances Test::More provides a handful of useful functions.
+
+B<NOTE> I'm not quite sure what will happen with filehandles.
+
+=over 4
+
+=item B<is_deeply>
+
+  is_deeply( $this, $that, $test_name );
+
+Similar to is(), except that if $this and $that are references, it
+does a deep comparison walking each data structure to see if they are
+equivalent.  If the two structures are different, it will display the
+place where they start differing.
+
+is_deeply() compares the dereferenced values of references, the
+references themselves (except for their type) are ignored.  This means
+aspects such as blessing and ties are not considered "different".
+
+Test::Differences and Test::Deep provide more in-depth functionality
+along these lines.
+
+=cut
+
+use vars qw(@Data_Stack %Refs_Seen);
+my $DNE = bless [], 'Does::Not::Exist';
+sub is_deeply {
+    my $tb = Test::More->builder;
+
+    unless( @_ == 2 or @_ == 3 ) {
+        my $msg = <<WARNING;
+is_deeply() takes two or three args, you gave %d.
+This usually means you passed an array or hash instead 
+of a reference to it
+WARNING
+        chop $msg;   # clip off newline so carp() will put in line/file
+
+        _carp sprintf $msg, scalar @_;
+
+       return $tb->ok(0);
+    }
+
+    my($this, $that, $name) = @_;
+
+    $tb->_unoverload_str(\$that, \$this);
+
+    my $ok;
+    if( !ref $this and !ref $that ) {                  # neither is a reference
+        $ok = $tb->is_eq($this, $that, $name);
+    }
+    elsif( !ref $this xor !ref $that ) {       # one's a reference, one isn't
+        $ok = $tb->ok(0, $name);
+       $tb->diag( _format_stack({ vals => [ $this, $that ] }) );
+    }
+    else {                                     # both references
+        local @Data_Stack = ();
+        if( _deep_check($this, $that) ) {
+            $ok = $tb->ok(1, $name);
+        }
+        else {
+            $ok = $tb->ok(0, $name);
+            $tb->diag(_format_stack(@Data_Stack));
+        }
+    }
+
+    return $ok;
+}
+
+sub _format_stack {
+    my(@Stack) = @_;
+
+    my $var = '$FOO';
+    my $did_arrow = 0;
+    foreach my $entry (@Stack) {
+        my $type = $entry->{type} || '';
+        my $idx  = $entry->{'idx'};
+        if( $type eq 'HASH' ) {
+            $var .= "->" unless $did_arrow++;
+            $var .= "{$idx}";
+        }
+        elsif( $type eq 'ARRAY' ) {
+            $var .= "->" unless $did_arrow++;
+            $var .= "[$idx]";
+        }
+        elsif( $type eq 'REF' ) {
+            $var = "\${$var}";
+        }
+    }
+
+    my @vals = @{$Stack[-1]{vals}}[0,1];
+    my @vars = ();
+    ($vars[0] = $var) =~ s/\$FOO/     \$got/;
+    ($vars[1] = $var) =~ s/\$FOO/\$expected/;
+
+    my $out = "Structures begin differing at:\n";
+    foreach my $idx (0..$#vals) {
+        my $val = $vals[$idx];
+        $vals[$idx] = !defined $val ? 'undef'          :
+                      $val eq $DNE  ? "Does not exist" :
+                     ref $val      ? "$val"           :
+                                      "'$val'";
+    }
+
+    $out .= "$vars[0] = $vals[0]\n";
+    $out .= "$vars[1] = $vals[1]\n";
+
+    $out =~ s/^/    /msg;
+    return $out;
+}
+
+
+sub _type {
+    my $thing = shift;
+
+    return '' if !ref $thing;
+
+    for my $type (qw(ARRAY HASH REF SCALAR GLOB Regexp)) {
+        return $type if UNIVERSAL::isa($thing, $type);
+    }
+
+    return '';
+}
+
+=back
+
+
+=head2 Diagnostics
+
+If you pick the right test function, you'll usually get a good idea of
+what went wrong when it failed.  But sometimes it doesn't work out
+that way.  So here we have ways for you to write your own diagnostic
+messages which are safer than just C<print STDERR>.
+
+=over 4
+
+=item B<diag>
+
+  diag(@diagnostic_message);
+
+Prints a diagnostic message which is guaranteed not to interfere with
+test output.  Like C<print> @diagnostic_message is simply concatenated
+together.
+
+Handy for this sort of thing:
+
+    ok( grep(/foo/, @users), "There's a foo user" ) or
+        diag("Since there's no foo, check that /etc/bar is set up right");
+
+which would produce:
+
+    not ok 42 - There's a foo user
+    #   Failed test 'There's a foo user'
+    #   in foo.t at line 52.
+    # Since there's no foo, check that /etc/bar is set up right.
+
+You might remember C<ok() or diag()> with the mnemonic C<open() or
+die()>.
+
+B<NOTE> The exact formatting of the diagnostic output is still
+changing, but it is guaranteed that whatever you throw at it it won't
+interfere with the test.
+
+=cut
+
+sub diag {
+    my $tb = Test::More->builder;
+
+    $tb->diag(@_);
+}
+
+
+=back
+
+
 =head2 Conditional tests
 
 Sometimes running a test under certain conditions will cause the
@@ -867,16 +982,17 @@ use TODO.  Read on.
 #'#
 sub skip {
     my($why, $how_many) = @_;
+    my $tb = Test::More->builder;
 
     unless( defined $how_many ) {
         # $how_many can only be avoided when no_plan is in use.
         _carp "skip() needs to know \$how_many tests are in the block"
-          unless $Test->has_plan eq 'no_plan';
+          unless $tb->has_plan eq 'no_plan';
         $how_many = 1;
     }
 
     for( 1..$how_many ) {
-        $Test->skip($why);
+        $tb->skip($why);
     }
 
     local $^W = 0;
@@ -922,7 +1038,7 @@ Once a todo test starts succeeding, simply move it outside the block.
 When the block is empty, delete it.
 
 B<NOTE>: TODO tests require a Test::Harness upgrade else it will
-treat it as a normal failure.  See L<BUGS and CAVEATS>)
+treat it as a normal failure.  See L<CAVEATS and NOTES>).
 
 
 =item B<todo_skip>
@@ -947,16 +1063,17 @@ interpret them as passing.
 
 sub todo_skip {
     my($why, $how_many) = @_;
+    my $tb = Test::More->builder;
 
     unless( defined $how_many ) {
         # $how_many can only be avoided when no_plan is in use.
         _carp "todo_skip() needs to know \$how_many tests are in the block"
-          unless $Test->has_plan eq 'no_plan';
+          unless $tb->has_plan eq 'no_plan';
         $how_many = 1;
     }
 
     for( 1..$how_many ) {
-        $Test->todo_skip($why);
+        $tb->todo_skip($why);
     }
 
     local $^W = 0;
@@ -977,124 +1094,34 @@ but want to put tests in your testing script (always a good idea).
 
 =back
 
-=head2 Complex data structures
 
-Not everything is a simple eq check or regex.  There are times you
-need to see if two data structures are equivalent.  For these
-instances Test::More provides a handful of useful functions.
-
-B<NOTE> I'm not quite sure what will happen with filehandles.
+=head2 Test control
 
 =over 4
 
-=item B<is_deeply>
+=item B<BAIL_OUT>
 
-  is_deeply( $this, $that, $test_name );
+    BAIL_OUT($reason);
 
-Similar to is(), except that if $this and $that are hash or array
-references, it does a deep comparison walking each data structure to
-see if they are equivalent.  If the two structures are different, it
-will display the place where they start differing.
+Incidates to the harness that things are going so badly all testing
+should terminate.  This includes the running any additional test scripts.
 
-Test::Differences and Test::Deep provide more in-depth functionality
-along these lines.
+This is typically used when testing cannot continue such as a critical
+module failing to compile or a necessary external utility not being
+available such as a database connection failing.
 
-=cut
+The test will exit with 255.
 
-use vars qw(@Data_Stack %Refs_Seen);
-my $DNE = bless [], 'Does::Not::Exist';
-sub is_deeply {
-    unless( @_ == 2 or @_ == 3 ) {
-        my $msg = <<WARNING;
-is_deeply() takes two or three args, you gave %d.
-This usually means you passed an array or hash instead 
-of a reference to it
-WARNING
-        chop $msg;   # clip off newline so carp() will put in line/file
-
-        _carp sprintf $msg, scalar @_;
-
-       return $Test->ok(0);
-    }
-
-    my($this, $that, $name) = @_;
-
-    my $ok;
-    if( !ref $this and !ref $that ) {                  # neither is a reference
-        $ok = $Test->is_eq($this, $that, $name);
-    }
-    elsif( !ref $this xor !ref $that ) {       # one's a reference, one isn't
-        $ok = $Test->ok(0, $name);
-       $Test->diag( _format_stack({ vals => [ $this, $that ] }) );
-    }
-    else {                                     # both references
-        local @Data_Stack = ();
-        if( _deep_check($this, $that) ) {
-            $ok = $Test->ok(1, $name);
-        }
-        else {
-            $ok = $Test->ok(0, $name);
-            $Test->diag(_format_stack(@Data_Stack));
-        }
-    }
-
-    return $ok;
-}
-
-sub _format_stack {
-    my(@Stack) = @_;
-
-    my $var = '$FOO';
-    my $did_arrow = 0;
-    foreach my $entry (@Stack) {
-        my $type = $entry->{type} || '';
-        my $idx  = $entry->{'idx'};
-        if( $type eq 'HASH' ) {
-            $var .= "->" unless $did_arrow++;
-            $var .= "{$idx}";
-        }
-        elsif( $type eq 'ARRAY' ) {
-            $var .= "->" unless $did_arrow++;
-            $var .= "[$idx]";
-        }
-        elsif( $type eq 'REF' ) {
-            $var = "\${$var}";
-        }
-    }
-
-    my @vals = @{$Stack[-1]{vals}}[0,1];
-    my @vars = ();
-    ($vars[0] = $var) =~ s/\$FOO/     \$got/;
-    ($vars[1] = $var) =~ s/\$FOO/\$expected/;
-
-    my $out = "Structures begin differing at:\n";
-    foreach my $idx (0..$#vals) {
-        my $val = $vals[$idx];
-        $vals[$idx] = !defined $val ? 'undef'          :
-                      $val eq $DNE  ? "Does not exist" :
-                     ref $val      ? "$val"           :
-                                      "'$val'";
-    }
+=cut
 
-    $out .= "$vars[0] = $vals[0]\n";
-    $out .= "$vars[1] = $vals[1]\n";
+sub BAIL_OUT {
+    my $reason = shift;
+    my $tb = Test::More->builder;
 
-    $out =~ s/^/    /msg;
-    return $out;
+    $tb->BAIL_OUT($reason);
 }
 
-
-sub _type {
-    my $thing = shift;
-
-    return '' if !ref $thing;
-
-    for my $type (qw(ARRAY HASH REF SCALAR GLOB Regexp)) {
-        return $type if UNIVERSAL::isa($thing, $type);
-    }
-
-    return '';
-}
+=back
 
 
 =head2 Discouraged comparison functions
@@ -1115,6 +1142,7 @@ C<is_deeply()> can do that better and with diagnostics.
 
 They may be deprecated in future versions.
 
+=over 4
 
 =item B<eq_array>
 
@@ -1159,6 +1187,8 @@ sub _eq_array  {
 
 sub _deep_check {
     my($e1, $e2) = @_;
+    my $tb = Test::More->builder;
+
     my $ok = 0;
 
     # Effectively turn %Refs_Seen into a stack.  This avoids picking up
@@ -1170,7 +1200,7 @@ sub _deep_check {
         # Quiet uninitialized value warnings when comparing undefs.
         local $^W = 0; 
 
-        $Test->_unoverload(\$e1, \$e2);
+        $tb->_unoverload_str(\$e1, \$e2);
 
         # Either they're both references or both not.
         my $same_ref = !(!ref $e1 xor !ref $e2);
@@ -1298,6 +1328,11 @@ Is better written:
 B<NOTE> By historical accident, this is not a true set comparison.
 While the order of elements does not matter, duplicate elements do.
 
+B<NOTE> eq_set() does not know how to deal with references at the top
+level.  The following is an example of a comparison which might not work:
+
+    eq_set([\1, \2], [\2, \1]);
+
 Test::Deep contains much better set comparison functions.
 
 =cut
@@ -1309,14 +1344,20 @@ sub eq_set  {
     # There's faster ways to do this, but this is easiest.
     local $^W = 0;
 
-    # We must make sure that references are treated neutrally.  It really
-    # doesn't matter how we sort them, as long as both arrays are sorted
-    # with the same algorithm.
+    # It really doesn't matter how we sort them, as long as both arrays are 
+    # sorted with the same algorithm.
+    #
+    # Ensure that references are not accidentally treated the same as a
+    # string containing the reference.
+    #
     # Have to inline the sort routine due to a threading/sort bug.
     # See [rt.cpan.org 6782]
+    #
+    # I don't know how references would be sorted so we just don't sort
+    # them.  This means eq_set doesn't really work with refs.
     return eq_array(
-           [sort { ref $a ? -1 : ref $b ? 1 : $a cmp $b } @$a1],
-           [sort { ref $a ? -1 : ref $b ? 1 : $a cmp $b } @$a2]
+           [grep(ref, @$a1), sort( grep(!ref, @$a1) )],
+           [grep(ref, @$a2), sort( grep(!ref, @$a2) )],
     );
 }
 
@@ -1343,11 +1384,6 @@ you can access the underlying Test::Builder object like so:
 Returns the Test::Builder object underlying Test::More for you to play
 with.
 
-=cut
-
-sub builder {
-    return Test::Builder->new;
-}
 
 =back
 
@@ -1365,7 +1401,7 @@ considered a failure and will exit with 255.
 So the exit codes are...
 
     0                   all tests successful
-    255                 test died
+    255                 test died or all passed but wrong # of tests run
     any other number    how many failed (including missing or extras)
 
 If you fail more than 254 tests, it will be reported as 254.
@@ -1384,10 +1420,12 @@ Test::More works with Perls as old as 5.004_05.
 
 =item Overloaded objects
 
-String overloaded objects are compared B<as strings>.  This prevents
-Test::More from piercing an object's interface allowing better blackbox
-testing.  So if a function starts returning overloaded objects instead of
-bare strings your tests won't notice the difference.  This is good.
+String overloaded objects are compared B<as strings> (or in cmp_ok()'s
+case, strings or numbers as appropriate to the comparison op).  This
+prevents Test::More from piercing an object's interface allowing
+better blackbox testing.  So if a function starts returning overloaded
+objects instead of bare strings your tests won't notice the
+difference.  This is good.
 
 However, it does mean that functions like is_deeply() cannot be used to
 test the internals of string overloaded objects.  In this case I would
index f84ac5e..74cb1fc 100644 (file)
@@ -3,22 +3,15 @@ package Test::Simple;
 use 5.004;
 
 use strict 'vars';
-use vars qw($VERSION);
-$VERSION = '0.60';
+use vars qw($VERSION @ISA @EXPORT);
+$VERSION = '0.61';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
+use Test::Builder::Module;
+@ISA    = qw(Test::Builder::Module);
+@EXPORT = qw(ok);
 
-use Test::Builder;
-my $Test = Test::Builder->new;
-
-sub import {
-    my $self = shift;
-    my $caller = caller;
-    *{$caller.'::ok'} = \&ok;
-
-    $Test->exported_to($caller);
-    $Test->plan(@_);
-}
+my $CLASS = __PACKAGE__;
 
 
 =head1 NAME
@@ -85,7 +78,7 @@ will do what you mean (fail if stuff is empty)
 =cut
 
 sub ok ($;$) {
-    $Test->ok(@_);
+    $CLASS->builder->ok(@_);
 }
 
 
@@ -107,7 +100,7 @@ considered a failure and will exit with 255.
 So the exit codes are...
 
     0                   all tests successful
-    255                 test died
+    255                 test died or all passed but wrong # of tests run
     any other number    how many failed (including missing or extras)
 
 If you fail more than 254 tests, it will be reported as 254.
@@ -144,7 +137,8 @@ It will produce output like this:
     ok 2 - Title() get
     ok 3 - Director() get
     not ok 4 - Rating() get
-    #    Failed test (t/film.t at line 14)
+    #   Failed test 'Rating() get'
+    #   in t/film.t at line 14.
     ok 5 - NumExplodingSheep() get
     # Looks like you failed 1 tests of 5
 
index d046129..2f44ab6 100644 (file)
@@ -1,3 +1,51 @@
+0.61  Fri Sep 23 23:26:05 PDT 2005
+    - create.t was trying to read from a file before it had been closed
+      (and thus the changes may not have yet been written).
+    * is_deeply() would call stringification methods on non-object strings
+      which happened to be the name of a string overloaded class.
+      [rt.cpan.org 14675]
+
+0.60_02  Tue Aug  9 00:27:41 PDT 2005
+    * Added Test::Builder::Module.
+    - Changed Test::More and Test::Simple to use Test::Builder::Module
+    - Minor Win32 testing nit in fail-more.t
+    * Added no_diag() method to Test::Builder and changed Test::More's
+      no_diag internals to use that. [rt.cpan.org 8655]
+    * Deprecated no_diag() as an option to "use Test::More".  Call the
+      Test::Builder method instead.
+
+0.60_01  Sun Jul  3 18:11:58 PDT 2005
+    - Moved the docs around a little to better group all the testing
+      functions together. [rt.cpan.org 8388]
+    * Added a BAIL_OUT() function to Test::More [rt.cpan.org 8381]
+    - Changed Test::Builder->BAILOUT to BAIL_OUT to match other method's
+      naming conventions.  BAILOUT remains but is deprecated.
+    * Changed the standard failure diagnostics to include the test name.
+      [rt.cpan.org 12490]
+    - is_deeply() was broken for overloaded objects in the top level in
+      0.59_01.  [rt.cpan.org 13506]
+    - String overloaded objects without an 'eq' or '==' method are now
+      handled in cmp_ok() and is().
+    - cmp_ok() will now treat overloaded objects as numbers if the comparison
+      operator is numeric. [rt.cpan.org 13156]
+    - cmp_ok(), like() and unlike will now throw uninit warnings if their
+      arguments are undefined. [rt.cpan.org 13155]
+    - cmp_ok() will now throw warnings as if the comparison were run 
+      normally, for example cmp_ok(2, '==', 'foo') will warn about 'foo' 
+      not being numeric.  Previously all warnings in the comparison were
+      supressed. [rt.cpan.org 13155]
+    - Tests will now report *both* the number of tests failed and if the
+      wrong number of tests were run.  Previously if tests failed and the
+      wrong number were run it would only report the latter. 
+      [rt.cpan.org 13494]
+    - Missing or extra tests are not considered failures for the purposes
+      of calculating the exit code.  Should there be no failures but the
+      wrong number of tests the exit code will be 254.
+    - Avoiding an unbalanced sort in eq_set() [bugs.perl.org 36354]
+    - Documenting that eq_set() doesn't deal well with refs.
+    - Clarified how is_deeply() compares a bit.
+    * Once again working on 5.4.5.
+
 0.60  Tue May  3 14:20:34 PDT 2005
 
 0.59_01  Tue Apr 26 21:51:12 PDT 2005
index 7a290f4..d50c8b5 100644 (file)
@@ -5,12 +5,14 @@
 use Test::More;
 plan tests => 1;
 
+my $TH_Version = 2.03;
+
 require Test::Harness;
-unless( cmp_ok( $Test::Harness::VERSION, '>', 1.20, "T::H version" ) ) {
+unless( cmp_ok( $Test::Harness::VERSION, '>', $TH_Version, "T::H version" ) ) {
     diag <<INSTRUCTIONS;
 
 Test::Simple/More/Builder has features which depend on a version of
-Test::Harness greater than 1.20.  You have $Test::Harness::VERSION.
+Test::Harness greater than $TH_Version.  You have $Test::Harness::VERSION.
 Please install a new version from CPAN.
 
 If you've already tried to upgrade Test::Harness and still get this
diff --git a/lib/Test/Simple/t/bail_out.t b/lib/Test/Simple/t/bail_out.t
new file mode 100644 (file)
index 0000000..c05d028
--- /dev/null
@@ -0,0 +1,49 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+my $Exit_Code;
+BEGIN {
+    *CORE::GLOBAL::exit = sub { $Exit_Code = shift; };
+}
+
+
+use Test::Builder;
+use Test::More;
+use TieOut;
+
+my $output = tie *FAKEOUT, 'TieOut';
+my $TB = Test::More->builder;
+$TB->output(\*FAKEOUT);
+
+my $Test = Test::Builder->create;
+$Test->level(0);
+
+if( $] >= 5.005 ) {
+    $Test->plan(tests => 2);
+}
+else {
+    $Test->plan(skip_all => 
+          'CORE::GLOBAL::exit, introduced in 5.005, is needed for testing');
+}
+
+
+plan tests => 4;
+
+BAIL_OUT("ROCKS FALL! EVERYONE DIES!");
+
+
+$Test->is_eq( $output->read, <<'OUT' );
+1..4
+Bail out!  ROCKS FALL! EVERYONE DIES!
+OUT
+
+$Test->is_eq( $Exit_Code, 255 );
index 7d266d9..5600d68 100644 (file)
@@ -16,21 +16,23 @@ use Test::More tests => 8;
 use Test::Builder;
 
 my $more_tb = Test::More->builder;
-my $new_tb  = Test::Builder->create;
-
-isa_ok $new_tb,  'Test::Builder';
 isa_ok $more_tb, 'Test::Builder';
 
-isnt $more_tb, $new_tb, 'Test::Builder->create makes a new object';
-
 is $more_tb, Test::More->builder, 'create does not interfere with ->builder';
 is $more_tb, Test::Builder->new,  '       does not interfere with ->new';
 
-$new_tb->output("some_file");
-END { 1 while unlink "some_file" }
+{
+    my $new_tb  = Test::Builder->create;
+
+    isa_ok $new_tb,  'Test::Builder';
+    isnt $more_tb, $new_tb, 'Test::Builder->create makes a new object';
 
-$new_tb->plan(tests => 1);
-$new_tb->ok(1);
+    $new_tb->output("some_file");
+    END { 1 while unlink "some_file" }
+
+    $new_tb->plan(tests => 1);
+    $new_tb->ok(1);
+}
 
 pass("Changing output() of new TB doesn't interfere with singleton");
 
index 4785507..fbdc52d 100644 (file)
@@ -14,8 +14,21 @@ chdir 't';
 use strict;
 use Test::More;
 
-plan tests => 2;
+plan tests => 4;
 
 # RT 3747
 ok( eq_set([1, 2, [3]], [[3], 1, 2]) );
 ok( eq_set([1,2,[3]], [1,[3],2]) );
+
+# bugs.perl.org 36354
+my $ref = \2;
+ok( eq_set( [$ref, "$ref", "$ref", $ref],
+            ["$ref", $ref, $ref, "$ref"] 
+          ) );
+
+TODO: {
+    local $TODO = q[eq_set() doesn't really handle references];
+
+    ok( eq_set( [\1, \2, \3], [\2, \3, \1] ) );
+}
+
index 0e30ce7..6630b64 100644 (file)
@@ -51,8 +51,9 @@ my %Tests = (
              'one_fail.plx'             => [1,      4],
              'two_fail.plx'             => [2,      4],
              'five_fail.plx'            => [5,      4],
-             'extras.plx'               => [3,      4],
-             'too_few.plx'              => [4,      4],
+             'extras.plx'               => [2,      4],
+             'too_few.plx'              => [255,    4],
+             'too_few_fail.plx'         => [2,      4],
              'death.plx'                => [255,    4],
              'last_minute_death.plx'    => [255,    4],
              'pre_plan_death.plx'       => ['not zero',    'not zero'],
index 4dceb2c..a005866 100644 (file)
@@ -10,20 +10,11 @@ BEGIN {
 # Can't use Test.pm, that's a 5.005 thing.
 package My::Test;
 
-print "1..2\n";
-
-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++;
-}
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 2);
 
 
 package main;
@@ -46,7 +37,7 @@ ok(1, 'Car');
 ok(0, 'Sar');
 
 END {
-    My::Test::ok($$out eq <<OUT);
+    $TB->is_eq($$out, <<OUT);
 1..3
 ok 1 - Foo
 not ok 2 - Bar
@@ -55,10 +46,13 @@ ok 4 - Car
 not ok 5 - Sar
 OUT
 
-    My::Test::ok($$err eq <<ERR);
-#     Failed test ($0 at line 31)
-#     Failed test ($0 at line 34)
+    $TB->is_eq($$err, <<ERR);
+#   Failed test 'Bar'
+#   in $0 at line 31.
+#   Failed test 'Sar'
+#   in $0 at line 34.
 # Looks like you planned 3 tests but ran 2 extra.
+# Looks like you failed 2 tests of 5 run.
 ERR
 
     exit 0;
index f8dacc6..30830d3 100644 (file)
@@ -18,20 +18,13 @@ my($out, $err) = Test::Simple::Catch::caught();
 # Can't use Test.pm, that's a 5.005 thing.
 package My::Test;
 
-print "1..2\n";
-
-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++;
-}
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 2);
+
+sub is { $TB->is_eq(@_) }
 
 
 package main;
@@ -43,14 +36,14 @@ ok(1);
 ok(1);
 
 END {
-    My::Test::ok($$out eq <<OUT);
+    My::Test::is($$out, <<OUT);
 1..1
 ok 1
 ok 2
 ok 3
 OUT
 
-    My::Test::ok($$err eq <<ERR);
+    My::Test::is($$err, <<ERR);
 # Looks like you planned 1 test but ran 2 extra.
 ERR
 
index 799762f..5631b58 100644 (file)
@@ -22,28 +22,20 @@ BEGIN {
 
 use strict;
 
-require Test::Simple::Catch;
-my($out, $err) = Test::Simple::Catch::caught();
-local $ENV{HARNESS_ACTIVE} = 0;
-
 
 # Can't use Test.pm, that's a 5.005 thing.
 package My::Test;
 
-print "1..2\n";
-
-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++;
-}
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 2);
+
+
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
 
 
 package main;
@@ -55,20 +47,21 @@ eval q{ like( "foo", qr/that/, 'is foo like that' ); };
 
 
 END {
-    My::Test::ok($$out eq <<OUT, 'failing output');
+    $TB->is_eq($$out, <<OUT, 'failing output');
 1..1
 not ok 1 - is foo like that
 OUT
 
     my $err_re = <<ERR;
-#     Failed test \\(.*\\)
+#   Failed test 'is foo like that'
+#   in .* at line 1\.
 #                   'foo'
 #     doesn't match '\\(\\?-xism:that\\)'
 # Looks like you failed 1 test of 1\\.
 ERR
 
 
-    My::Test::ok($$err =~ /^$err_re$/, 'failing errors');
+    $TB->like($$err, qr/^$err_re$/, 'failing errors');
 
     exit(0);
 }
index 2086df2..6f9d634 100644 (file)
@@ -20,53 +20,45 @@ local $ENV{HARNESS_ACTIVE} = 0;
 # Can't use Test.pm, that's a 5.005 thing.
 package My::Test;
 
-print "1..12\n";
-
-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;
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 17);
+
+sub like ($$;$) {
+    $TB->like(@_);
 }
 
+sub is ($$;$) {
+    $TB->is_eq(@_);
+}
 
 sub main::err_ok ($) {
     my($expect) = @_;
     my $got = $err->read;
 
-    my $ok = ok( $got eq $expect );
-
-    unless( $ok ) {
-        print STDERR "$got\n";
-        print STDERR "$expect\n";
-    }
-
-    return $ok;
+    return $TB->is_eq( $got, $expect );
 }
 
 
 package main;
 
 require Test::More;
-my $Total = 29;
+my $Total = 28;
 Test::More->import(tests => $Total);
 
 my $tb = Test::More->builder;
 $tb->use_numbers(0);
 
+my $Filename = quotemeta $0;
+
 # Preserve the line numbers.
 #line 38
 ok( 0, 'failing' );
 err_ok( <<ERR );
-#     Failed test ($0 at line 38)
+#   Failed test 'failing'
+#   in $0 at line 38.
 ERR
 
 #line 40
@@ -75,16 +67,20 @@ is( undef, '',    'undef is empty string?');
 is( undef, 0,     'undef is 0?');
 is( '',    0,     'empty string is 0?' );
 err_ok( <<ERR );
-#     Failed test ($0 at line 40)
+#   Failed test 'foo is bar?'
+#   in $0 at line 40.
 #          got: 'foo'
 #     expected: 'bar'
-#     Failed test ($0 at line 41)
+#   Failed test 'undef is empty string?'
+#   in $0 at line 41.
 #          got: undef
 #     expected: ''
-#     Failed test ($0 at line 42)
+#   Failed test 'undef is 0?'
+#   in $0 at line 42.
 #          got: undef
 #     expected: '0'
-#     Failed test ($0 at line 43)
+#   Failed test 'empty string is 0?'
+#   in $0 at line 43.
 #          got: ''
 #     expected: '0'
 ERR
@@ -94,15 +90,18 @@ isnt("foo", "foo", 'foo isnt foo?' );
 isn't("foo", "foo",'foo isn\'t foo?' );
 isnt(undef, undef, 'undef isnt undef?');
 err_ok( <<ERR );
-#     Failed test ($0 at line 45)
+#   Failed test 'foo isnt foo?'
+#   in $0 at line 45.
 #     'foo'
 #         ne
 #     'foo'
-#     Failed test ($0 at line 46)
+#   Failed test 'foo isn\'t foo?'
+#   in $0 at line 46.
 #     'foo'
 #         ne
 #     'foo'
-#     Failed test ($0 at line 47)
+#   Failed test 'undef isnt undef?'
+#   in $0 at line 47.
 #     undef
 #         ne
 #     undef
@@ -112,35 +111,43 @@ ERR
 like( "foo", '/that/',  'is foo like that' );
 unlike( "foo", '/foo/', 'is foo unlike foo' );
 err_ok( <<ERR );
-#     Failed test ($0 at line 48)
+#   Failed test 'is foo like that'
+#   in $0 at line 48.
 #                   'foo'
 #     doesn't match '/that/'
-#     Failed test ($0 at line 49)
+#   Failed test 'is foo unlike foo'
+#   in $0 at line 49.
 #                   'foo'
 #           matches '/foo/'
 ERR
 
 # Nick Clark found this was a bug.  Fixed in 0.40.
+# line 60
 like( "bug", '/(%)/',   'regex with % in it' );
 err_ok( <<ERR );
-#     Failed test ($0 at line 60)
+#   Failed test 'regex with % in it'
+#   in $0 at line 60.
 #                   'bug'
 #     doesn't match '/(%)/'
 ERR
 
+#line 67
 fail('fail()');
 err_ok( <<ERR );
-#     Failed test ($0 at line 67)
+#   Failed test 'fail()'
+#   in $0 at line 67.
 ERR
 
 #line 52
 can_ok('Mooble::Hooble::Yooble', qw(this that));
 can_ok('Mooble::Hooble::Yooble', ());
 err_ok( <<ERR );
-#     Failed test ($0 at line 52)
+#   Failed test 'Mooble::Hooble::Yooble->can(...)'
+#   in $0 at line 52.
 #     Mooble::Hooble::Yooble->can('this') failed
 #     Mooble::Hooble::Yooble->can('that') failed
-#     Failed test ($0 at line 53)
+#   Failed test 'Mooble::Hooble::Yooble->can(...)'
+#   in $0 at line 53.
 #     can_ok() called with no methods
 ERR
 
@@ -150,13 +157,17 @@ isa_ok(42,    "Wibble", "My Wibble");
 isa_ok(undef, "Wibble", "Another Wibble");
 isa_ok([],    "HASH");
 err_ok( <<ERR );
-#     Failed test ($0 at line 55)
+#   Failed test 'The object isa Wibble'
+#   in $0 at line 55.
 #     The object isn't a 'Wibble' it's a 'Foo'
-#     Failed test ($0 at line 56)
+#   Failed test 'My Wibble isa Wibble'
+#   in $0 at line 56.
 #     My Wibble isn't a reference
-#     Failed test ($0 at line 57)
+#   Failed test 'Another Wibble isa Wibble'
+#   in $0 at line 57.
 #     Another Wibble isn't defined
-#     Failed test ($0 at line 58)
+#   Failed test 'The object isa HASH'
+#   in $0 at line 58.
 #     The object isn't a 'HASH' it's a 'ARRAY'
 ERR
 
@@ -165,35 +176,56 @@ cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
 cmp_ok( 42.1,  '==', 23,  , '       ==' );
 cmp_ok( 42,    '!=', 42   , '       !=' );
 cmp_ok( 1,     '&&', 0    , '       &&' );
-cmp_ok( 42,    '==', "foo", '       == with strings' );
-cmp_ok( 42,    'eq', "foo", '       eq with numbers' );
-cmp_ok( undef, 'eq', 'foo', '       eq with undef' );
 err_ok( <<ERR );
-#     Failed test ($0 at line 68)
+#   Failed test 'cmp_ok eq'
+#   in $0 at line 68.
 #          got: 'foo'
 #     expected: 'bar'
-#     Failed test ($0 at line 69)
+#   Failed test '       =='
+#   in $0 at line 69.
 #          got: 42.1
 #     expected: 23
-#     Failed test ($0 at line 70)
+#   Failed test '       !='
+#   in $0 at line 70.
 #     '42'
 #         !=
 #     '42'
-#     Failed test ($0 at line 71)
+#   Failed test '       &&'
+#   in $0 at line 71.
 #     '1'
 #         &&
 #     '0'
-#     Failed test ($0 at line 72)
-#          got: 42
-#     expected: 0
-#     Failed test ($0 at line 73)
+ERR
+
+
+# line 196
+cmp_ok( 42,    'eq', "foo", '       eq with numbers' );
+err_ok( <<ERR );
+#   Failed test '       eq with numbers'
+#   in $0 at line 196.
 #          got: '42'
 #     expected: 'foo'
-#     Failed test ($0 at line 74)
-#          got: undef
-#     expected: 'foo'
 ERR
 
+
+{
+    my $warnings;
+    local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
+
+# line 211
+    cmp_ok( 42,    '==', "foo", '       == with strings' );
+    err_ok( <<ERR );
+#   Failed test '       == with strings'
+#   in $0 at line 211.
+#          got: 42
+#     expected: foo
+ERR
+    My::Test::like $warnings,
+     qq[/^Argument "foo" isn't numeric in .* at $Filename line 211\\\.\n\$/];
+
+}
+
+
 # generate a $!, it changes its value by context.
 -e "wibblehibble";
 my $Errno_Number = $!+0;
@@ -202,21 +234,45 @@ my $Errno_String = $!.'';
 cmp_ok( $!,    'eq', '',    '       eq with stringified errno' );
 cmp_ok( $!,    '==', -1,    '       eq with numerified errno' );
 err_ok( <<ERR );
-#     Failed test ($0 at line 80)
+#   Failed test '       eq with stringified errno'
+#   in $0 at line 80.
 #          got: '$Errno_String'
 #     expected: ''
-#     Failed test ($0 at line 81)
+#   Failed test '       eq with numerified errno'
+#   in $0 at line 81.
 #          got: $Errno_Number
 #     expected: -1
 ERR
 
 #line 84
 use_ok('Hooble::mooble::yooble');
+
+my $more_err_re = <<ERR;
+#   Failed test 'use Hooble::mooble::yooble;'
+#   in $Filename at line 84\\.
+#     Tried to use 'Hooble::mooble::yooble'.
+#     Error:  Can't locate Hooble.* in \\\@INC .*
+# BEGIN failed--compilation aborted at $Filename line 84.
+ERR
+
+My::Test::like($err->read, "/^$more_err_re/");
+
+
+#line 85
 require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
+$more_err_re = <<ERR;
+#   Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;'
+#   in $Filename at line 85\\.
+#     Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
+#     Error:  Can't locate ALL.* in \\\@INC .*
+ERR
+
+My::Test::like($err->read, "/^$more_err_re/");
+
 
 #line 88
 END {
-    My::Test::ok($$out eq <<OUT, 'failing output');
+    $TB->is_eq($$out, <<OUT, 'failing output');
 1..$Total
 not ok - failing
 not ok - foo is bar?
@@ -240,33 +296,17 @@ not ok - cmp_ok eq
 not ok -        ==
 not ok -        !=
 not ok -        &&
-not ok -        == with strings
 not ok -        eq with numbers
-not ok -        eq with undef
+not ok -        == with strings
 not ok -        eq with stringified errno
 not ok -        eq with numerified errno
 not ok - use Hooble::mooble::yooble;
 not ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;
 OUT
 
-   my $filename = quotemeta $0;
-   my $more_err_re = <<ERR;
-#     Failed test \\($filename at line 84\\)
-#     Tried to use 'Hooble::mooble::yooble'.
-#     Error:  Can't locate Hooble.* in \\\@INC .*
-# BEGIN failed--compilation aborted at $filename line 84.
-#     Failed test \\($filename at line 85\\)
-#     Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
-#     Error:  Can't locate ALL.* in \\\@INC .*
+err_ok( <<ERR );
 # Looks like you failed $Total tests of $Total.
 ERR
 
-    unless( My::Test::ok($$err =~ /^$more_err_re$/, 
-                         'failing errors') ) {
-        print $$err;
-        print "regex:\n";
-        print $more_err_re;
-    }
-
     exit(0);
 }
index 30a107b..822fcb8 100644 (file)
@@ -60,8 +60,10 @@ not ok 5 - damnit
 OUT
 
     My::Test::ok($$err eq <<ERR);
-#     Failed test ($0 at line 38)
-#     Failed test ($0 at line 39)
+#   Failed test 'oh no!'
+#   in $0 at line 38.
+#   Failed test 'damnit'
+#   in $0 at line 39.
 # Looks like you failed 2 tests of 5.
 ERR
 
index d379a77..fe22624 100644 (file)
@@ -53,7 +53,7 @@ not ok 1
 OUT
 
     My::Test::ok($$err eq <<ERR) || print $$err;
-#     Failed test ($0 at line 45)
+#   Failed test in $0 at line 45.
 # Looks like you failed 1 test of 1.
 ERR
 
index fac5a7f..d3ae56a 100644 (file)
@@ -19,21 +19,15 @@ my($out, $err) = Test::Simple::Catch::caught();
 # Can't use Test.pm, that's a 5.005 thing.
 package My::Test;
 
-print "1..4\n";
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 4);
 
-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;
+    return $TB->ok(@_);
 }
 
 
@@ -41,14 +35,7 @@ sub main::err_ok ($) {
     my($expect) = @_;
     my $got = $err->read;
 
-    my $ok = ok( $got eq $expect );
-
-    unless( $ok ) {
-        print STDERR "got\n$got\n";
-        print STDERR "expected\n$expect\n";
-    }
-
-    return $ok;
+    return $TB->is_eq( $got, $expect );
 }
 
 
@@ -64,13 +51,14 @@ Test::More->builder->no_ending(1);
 #line 62
     fail( "this fails" );
     err_ok( <<ERR );
-#     Failed test ($0 at line 62)
+#   Failed test 'this fails'
+#   in $0 at line 62.
 ERR
 
 #line 72
     is( 1, 0 );
     err_ok( <<ERR );
-#     Failed test ($0 at line 72)
+#   Failed test in $0 at line 72.
 #          got: '1'
 #     expected: '0'
 ERR
@@ -83,7 +71,8 @@ ERR
     fail( "this fails" );
     err_ok( <<ERR );
 
-#     Failed test ($0 at line 71)
+#   Failed test 'this fails'
+#   in $0 at line 71.
 ERR
 
 
@@ -91,7 +80,7 @@ ERR
     is( 1, 0 );
     err_ok( <<ERR );
 
-#     Failed test ($0 at line 84)
+#   Failed test in $0 at line 84.
 #          got: '1'
 #     expected: '0'
 ERR
index 33e0923..e13ea4a 100644 (file)
@@ -15,18 +15,6 @@ BEGIN {
     }
 }
 
-BEGIN {
-    require Test::Harness;
-}
-
-# This feature requires a fairly new version of Test::Harness
-if( $Test::Harness::VERSION < 2.03 ) {
-    plan tests => 1;
-    diag "Need Test::Harness 2.03 or up.  You have $Test::Harness::VERSION.";
-    fail 'Need Test::Harness 2.03 or up';
-    exit;
-}
-
 use strict;
 use Test::Builder;
 
index ed61ee8..48f3828 100644 (file)
@@ -44,7 +44,7 @@ sub is ($$;$) {
 
 sub like ($$;$) {
     my($this, $regex, $name) = @_;
-    $regex = qr/$regex/ unless ref $regex;
+    $regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s;
 
     my $ok = $TB->like($$this, $regex, $name);
 
@@ -63,7 +63,8 @@ my $Filename = quotemeta $0;
 ok !is_deeply('foo', 'bar', 'plain strings');
 is( $out, "not ok 1 - plain strings\n",     'plain strings' );
 is( $err, <<ERR,                            '    right diagnostic' );
-#     Failed test ($0 at line 68)
+#   Failed test 'plain strings'
+#   in $0 at line 68.
 #          got: 'foo'
 #     expected: 'bar'
 ERR
@@ -73,7 +74,8 @@ ERR
 ok !is_deeply({}, [], 'different types');
 is( $out, "not ok 2 - different types\n",   'different types' );
 like( $err, <<ERR,                          '   right diagnostic' );
-#     Failed test \\($Filename at line 78\\)
+#   Failed test 'different types'
+#   in $Filename at line 78.
 #     Structures begin differing at:
 #          \\\$got = HASH\\(0x[0-9a-f]+\\)
 #     \\\$expected = ARRAY\\(0x[0-9a-f]+\\)
@@ -84,7 +86,8 @@ ok !is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values');
 is( $out, "not ok 3 - hashes with different values\n", 
                                         'hashes with different values' );
 is( $err, <<ERR,                        '   right diagnostic' );
-#     Failed test ($0 at line 88)
+#   Failed test 'hashes with different values'
+#   in $0 at line 88.
 #     Structures begin differing at:
 #          \$got->{this} = '42'
 #     \$expected->{this} = '43'
@@ -95,7 +98,8 @@ ok !is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys');
 is( $out, "not ok 4 - hashes with different keys\n",
                                         'hashes with different keys' );
 is( $err, <<ERR,                        '    right diagnostic' );
-#     Failed test ($0 at line 99)
+#   Failed test 'hashes with different keys'
+#   in $0 at line 99.
 #     Structures begin differing at:
 #          \$got->{this} = Does not exist
 #     \$expected->{this} = '42'
@@ -106,7 +110,8 @@ ok !is_deeply([1..9], [1..10],    'arrays of different length');
 is( $out, "not ok 5 - arrays of different length\n",
                                         'arrays of different length' );
 is( $err, <<ERR,                        '    right diagnostic' );
-#     Failed test ($0 at line 110)
+#   Failed test 'arrays of different length'
+#   in $0 at line 110.
 #     Structures begin differing at:
 #          \$got->[9] = Does not exist
 #     \$expected->[9] = '10'
@@ -116,7 +121,8 @@ ERR
 ok !is_deeply([undef, undef], [undef], 'arrays of undefs' );
 is( $out, "not ok 6 - arrays of undefs\n",  'arrays of undefs' );
 is( $err, <<ERR,                            '    right diagnostic' );
-#     Failed test ($0 at line 121)
+#   Failed test 'arrays of undefs'
+#   in $0 at line 121.
 #     Structures begin differing at:
 #          \$got->[1] = undef
 #     \$expected->[1] = Does not exist
@@ -126,7 +132,8 @@ ERR
 ok !is_deeply({ foo => undef }, {},    'hashes of undefs' );
 is( $out, "not ok 7 - hashes of undefs\n",  'hashes of undefs' );
 is( $err, <<ERR,                            '    right diagnostic' );
-#     Failed test ($0 at line 131)
+#   Failed test 'hashes of undefs'
+#   in $0 at line 131.
 #     Structures begin differing at:
 #          \$got->{foo} = undef
 #     \$expected->{foo} = Does not exist
@@ -136,7 +143,8 @@ ERR
 ok !is_deeply(\42, \23,   'scalar refs');
 is( $out, "not ok 8 - scalar refs\n",   'scalar refs' );
 is( $err, <<ERR,                        '    right diagnostic' );
-#     Failed test ($0 at line 141)
+#   Failed test 'scalar refs'
+#   in $0 at line 141.
 #     Structures begin differing at:
 #     \${     \$got} = '42'
 #     \${\$expected} = '23'
@@ -147,7 +155,8 @@ ok !is_deeply([], \23,    'mixed scalar and array refs');
 is( $out, "not ok 9 - mixed scalar and array refs\n",
                                         'mixed scalar and array refs' );
 like( $err, <<ERR,                      '    right diagnostic' );
-#     Failed test \\($Filename at line 151\\)
+#   Failed test 'mixed scalar and array refs'
+#   in $Filename at line 151.
 #     Structures begin differing at:
 #          \\\$got = ARRAY\\(0x[0-9a-f]+\\)
 #     \\\$expected = SCALAR\\(0x[0-9a-f]+\\)
@@ -166,7 +175,8 @@ $b3 = 23;
 ok !is_deeply($a1, $b1, 'deep scalar refs');
 is( $out, "not ok 10 - deep scalar refs\n",     'deep scalar refs' );
 is( $err, <<ERR,                              '    right diagnostic' );
-#     Failed test ($0 at line 173)
+#   Failed test 'deep scalar refs'
+#   in $0 at line 173.
 #     Structures begin differing at:
 #     \${\${     \$got}} = '42'
 #     \${\${\$expected}} = '23'
@@ -192,7 +202,8 @@ ok !is_deeply( $foo, $bar, 'deep structures' );
 ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
 is( $out, "not ok 11 - deep structures\n",  'deep structures' );
 is( $err, <<ERR,                            '    right diagnostic' );
-#     Failed test ($0 at line 198)
+#   Failed test 'deep structures'
+#   in $0 at line 198.
 #     Structures begin differing at:
 #          \$got->{that}{foo} = Does not exist
 #     \$expected->{that}{foo} = '42'
@@ -213,7 +224,7 @@ foreach my $test (@tests) {
     ok !is_deeply(@$test);
 
     like \$warning, 
-         qr/^is_deeply\(\) takes two or three args, you gave $num_args\.\n/;
+         "/^is_deeply\\(\\) takes two or three args, you gave $num_args\.\n/";
 }
 
 
@@ -241,7 +252,7 @@ $$err = $$out = '';
 ok !is_deeply( [\'a', 'b'], [\'a', 'c'] );
 is( $out, "not ok 20\n",  'scalar refs in an array' );
 is( $err, <<ERR,        '    right diagnostic' );
-#     Failed test ($0 at line 274)
+#   Failed test in $0 at line 274.
 #     Structures begin differing at:
 #          \$got->[1] = 'b'
 #     \$expected->[1] = 'c'
@@ -253,7 +264,7 @@ my $ref = \23;
 ok !is_deeply( 23, $ref );
 is( $out, "not ok 21\n", 'scalar vs ref' );
 is( $err, <<ERR,        '  right diagnostic');
-#     Failed test ($0 at line 286)
+#   Failed test in $0 at line 286.
 #     Structures begin differing at:
 #          \$got = '23'
 #     \$expected = $ref
@@ -263,7 +274,7 @@ ERR
 ok !is_deeply( $ref, 23 );
 is( $out, "not ok 22\n", 'ref vs scalar' );
 is( $err, <<ERR,        '  right diagnostic');
-#     Failed test ($0 at line 296)
+#   Failed test in $0 at line 296.
 #     Structures begin differing at:
 #          \$got = $ref
 #     \$expected = '23'
@@ -273,7 +284,7 @@ ERR
 ok !is_deeply( undef, [] );
 is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' );
 like( $err, <<ERR,      '  right diagnostic' );
-#     Failed test \\($Filename at line 306\\)
+#   Failed test in $Filename at line 306\\.
 #     Structures begin differing at:
 #          \\\$got = undef
 #     \\\$expected = ARRAY\\(0x[0-9a-f]+\\)
@@ -289,7 +300,7 @@ ERR
     ok !is_deeply( $array, $hash );
     is( $out, "not ok 24\n", 'is_deeply and different reference types' );
     is( $err, <<ERR,        '  right diagnostic' );
-#     Failed test ($0 at line 321)
+#   Failed test in $0 at line 321.
 #     Structures begin differing at:
 #          \$got = $array
 #     \$expected = $hash
@@ -299,7 +310,7 @@ ERR
     ok !is_deeply( [$array], [$hash] );
     is( $out, "not ok 25\n", 'nested different ref types' );
     is( $err, <<ERR,        '  right diagnostic' );
-#     Failed test ($0 at line 332)
+#   Failed test in $0 at line 332.
 #     Structures begin differing at:
 #          \$got->[0] = $array
 #     \$expected->[0] = $hash
@@ -312,14 +323,14 @@ ERR
 
        {
            package Bar;
-           overload->import(q[""] => sub { "wibble" });
+           "overload"->import(q[""] => sub { "wibble" });
        }
 
 #line 353
        ok !is_deeply( [$foo], [$bar] );
        is( $out, "not ok 26\n", 'string overloaded refs respected in diag' );
        is( $err, <<ERR,             '  right diagnostic' );
-#     Failed test ($0 at line 353)
+#   Failed test in $0 at line 353.
 #     Structures begin differing at:
 #          \$got->[0] = $foo
 #     \$expected->[0] = 'wibble'
index f8a4581..e57cace 100644 (file)
@@ -11,20 +11,13 @@ BEGIN {
 # Can't use Test.pm, that's a 5.005 thing.
 package My::Test;
 
-print "1..2\n";
-
-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++;
-}
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 2);
+
+sub is { $TB->is_eq(@_) }
 
 
 package main;
@@ -42,15 +35,17 @@ ok(1, 'Foo');
 ok(0, 'Bar');
 
 END {
-    My::Test::ok($$out eq <<OUT);
+    My::Test::is($$out, <<OUT);
 1..5
 ok 1 - Foo
 not ok 2 - Bar
 OUT
 
-    My::Test::ok($$err eq <<ERR);
-#     Failed test ($0 at line 31)
+    My::Test::is($$err, <<ERR);
+#   Failed test 'Bar'
+#   in $0 at line 31.
 # Looks like you planned 5 tests but only ran 2.
+# Looks like you failed 1 test of 2 run.
 ERR
 
     exit 0;
index 21ecd03..6fa538a 100644 (file)
@@ -1,6 +1,8 @@
 #!/usr/bin/perl -w
 
-use Test::More 'no_diag', tests => 1;
+use Test::More 'no_diag', tests => 2;
 
 pass('foo');
 diag('This should not be displayed');
+
+is(Test::More->builder->no_diag, 1);
index 18e7c3d..e0e70d4 100644 (file)
@@ -18,7 +18,7 @@ BEGIN {
         plan skip_all => "needs overload.pm";
     }
     else {
-        plan tests => 7;
+        plan tests => 13;
     }
 }
 
@@ -27,8 +27,7 @@ package Overloaded;
 
 use overload
         q{""}    => sub { $_[0]->{string} },
-        q{0}     => sub { $_[0]->{num} },
-        fallback => 1;
+        q{0+}    => sub { $_[0]->{num} };
 
 sub new {
     my $class = shift;
@@ -43,8 +42,27 @@ isa_ok $obj, 'Overloaded';
 
 is $obj, 'foo',            'is() with string overloading';
 cmp_ok $obj, 'eq', 'foo',  'cmp_ok() ...';
-cmp_ok $obj, '==', 'foo',  'cmp_ok() with number overloading';
+cmp_ok $obj, '==', 42,     'cmp_ok() with number overloading';
 
 is_deeply [$obj], ['foo'],                 'is_deeply with string overloading';
 ok eq_array([$obj], ['foo']),              'eq_array ...';
 ok eq_hash({foo => $obj}, {foo => 'foo'}), 'eq_hash ...';
+
+# rt.cpan.org 13506
+is_deeply $obj, 'foo',        'is_deeply with string overloading at the top';
+
+Test::More->builder->is_num($obj, 42);
+Test::More->builder->is_eq ($obj, "foo");
+
+
+{
+    # rt.cpan.org 14675
+    package TestPackage;
+    use overload q{""} => sub { ::fail("This should not be called") };
+
+    package Foo;
+    ::is_deeply(['TestPackage'], ['TestPackage']);
+    ::is_deeply({'TestPackage' => 'TestPackage'}, 
+                {'TestPackage' => 'TestPackage'});
+    ::is_deeply('TestPackage', 'TestPackage');
+}
index 8c4492a..3111592 100644 (file)
@@ -13,18 +13,6 @@ BEGIN {
     }
 }
 
-BEGIN {
-    require Test::Harness;
-}
-
-# This feature requires a fairly new version of Test::Harness
-if( $Test::Harness::VERSION < 2.03 ) {
-    plan tests => 1;
-    diag "Need Test::Harness 2.03 or up.  You have $Test::Harness::VERSION.";
-    fail 'Need Test::Harness 2.03 or up';
-    exit;
-}
-
 plan 'no_plan';
 
 pass('Just testing');
index 14a7b00..3e5ad02 100644 (file)
@@ -7,20 +7,8 @@ BEGIN {
     }
 }
 
-require Test::Harness;
 use Test::More;
 
-# Shut up a "used only once" warning in 5.5.4.
-my $th_version  = $Test::Harness::VERSION = $Test::Harness::VERSION;
-$th_version =~ s/_//;   # for X.Y_Z alpha versions
-
-# TODO requires a fairly new version of Test::Harness
-if( $th_version < 2.03 ) {
-    plan tests => 1;
-    fail "Need Test::Harness 2.03 or up.  You have $th_version.";
-    exit;
-}
-
 plan tests => 18;
 
 
index e9180bb..7afb2a6 100644 (file)
@@ -11,7 +11,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 16;
+use Test::More tests => 18;
 use TieOut;
 
 BEGIN { $^W = 1; }
@@ -19,32 +19,59 @@ BEGIN { $^W = 1; }
 my $warnings = '';
 local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
 
+my $TB = Test::Builder->new;
+sub no_warnings {
+    $TB->is_eq($warnings, '', '  no warnings');
+    $warnings = '';
+}
+
+sub warnings_is {
+    $TB->is_eq($warnings, $_[0]);
+    $warnings = '';
+}
+
+sub warnings_like {
+    $TB->like($warnings, "/$_[0]/");
+    $warnings = '';
+}
+
+
+my $Filename = quotemeta $0;
+   
+
 is( undef, undef,           'undef is undef');
-is( $warnings, '',          '  no warnings' );
+no_warnings;
 
 isnt( undef, 'foo',         'undef isnt foo');
-is( $warnings, '',          '  no warnings' );
+no_warnings;
 
 isnt( undef, '',            'undef isnt an empty string' );
 isnt( undef, 0,             'undef isnt zero' );
 
+#line 45
 like( undef, '/.*/',        'undef is like anything' );
-is( $warnings, '',          '  no warnings' );
+warnings_like("Use of uninitialized value.* at $Filename line 45\\.\n");
 
 eq_array( [undef, undef], [undef, 23] );
-is( $warnings, '',          'eq_array()  no warnings' );
+no_warnings;
 
 eq_hash ( { foo => undef, bar => undef },
           { foo => undef, bar => 23 } );
-is( $warnings, '',          'eq_hash()   no warnings' );
+no_warnings;
 
 eq_set  ( [undef, undef, 12], [29, undef, undef] );
-is( $warnings, '',          'eq_set()    no warnings' );
+no_warnings;
 
 
 eq_hash ( { foo => undef, bar => { baz => undef, moo => 23 } },
           { foo => undef, bar => { baz => undef, moo => 23 } } );
-is( $warnings, '',          'eq_hash()   no warnings' );
+no_warnings;
+
+
+#line 64
+cmp_ok( undef, '<=', 2, '  undef <= 2' );
+warnings_like("Use of uninitialized value.* at $Filename line 64\\.\n");
+
 
 
 my $tb = Test::More->builder;
@@ -57,9 +84,9 @@ diag(undef);
 $tb->failure_output($old_fail);
 
 is( $caught->read, "# undef\n" );
-is( $warnings, '',          'diag(undef)  no warnings' );
+no_warnings;
 
 
 $tb->maybe_regex(undef);
 is( $caught->read, '' );
-is( $warnings, '',          'maybe_regex(undef) no warnings' );
+no_warnings;
diff --git a/t/lib/Test/Simple/sample_tests/too_few_fail.plx b/t/lib/Test/Simple/sample_tests/too_few_fail.plx
new file mode 100644 (file)
index 0000000..5910e13
--- /dev/null
@@ -0,0 +1,12 @@
+require Test::Simple;
+
+push @INC, 't/lib';
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+
+Test::Simple->import(tests => 5);
+
+
+ok(0);
+ok(1);
+ok(0);
\ No newline at end of file