From: Steve Hay <SteveHay@planit.com>
Date: Fri, 7 Nov 2008 10:32:32 +0000 (+0000)
Subject: Upgrade to Test-Simple-0.85_01, keeping local changes 34491 and 34545
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=82d700dc3bcb588c96407260d728895940e2cf09;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to Test-Simple-0.85_01, keeping local changes 34491 and 34545

p4raw-id: //depot/perl@34761
---

diff --git a/MANIFEST b/MANIFEST
index b474b81..8af2e5e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2883,6 +2883,7 @@ lib/Test/Simple/t/Builder/ok_obj.t	Test::Builder tests
 lib/Test/Simple/t/Builder/output.t	Test::Builder tests
 lib/Test/Simple/t/Builder/reset.t	Test::Builder tests
 lib/Test/Simple/t/Builder/try.t		Test::Builder tests
+lib/Test/Simple/t/c_flag.t	Test::Simple test
 lib/Test/Simple/t/circular_data.t	Test::Simple test
 lib/Test/Simple/t/cmp_ok.t	Test::More test
 lib/Test/Simple/t/diag.t	Test::More diag() test
diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm
index 531dd42..08f5616 100644
--- a/lib/Test/Builder.pm
+++ b/lib/Test/Builder.pm
@@ -5,7 +5,7 @@ use 5.006;
 use strict;
 use warnings;
 
-our $VERSION = '0.82_01';
+our $VERSION = '0.85_02';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 # Make Test::Builder thread-safe for ithreads.
@@ -457,7 +457,7 @@ sub _unoverload {
     my $self = shift;
     my $type = shift;
 
-    $self->_try( sub { require overload } ) || return;
+    $self->_try(sub { require overload; }, die_on_fail => 1);
 
     foreach my $thing (@_) {
         if( $self->_is_object($$thing) ) {
@@ -500,6 +500,9 @@ sub _unoverload_num {
 sub _is_dualvar {
     my( $self, $val ) = @_;
 
+    # Objects are not dualvars.
+    return 0 if ref $val;
+
     no warnings 'numeric';
     my $numval = $val + 0;
     return $numval != 0 and $numval ne $val ? 1 : 0;
@@ -698,34 +701,41 @@ 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;
+    my $error;
     {
         ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
         local( $@, $!, $SIG{__DIE__} );    # isolate eval
 
-        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;";
+        my($pack, $file, $line) = $self->caller();
 
+        $test = eval qq[
+#line 1 "cmp_ok [from $file line $line]"
+\$got $type \$expect;
+];
+        $error = $@;
     }
     local $Level = $Level + 1;
     my $ok = $self->ok( $test, $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->diag(<<"END") if $error;
+An error occurred while using $type:
+------------------------------------
+$error
+------------------------------------
+END
+
     unless($ok) {
+        $self->$unoverload( \$got, \$expect );
+
         if( $type =~ /^(eq|==)$/ ) {
             $self->_is_diag( $got, $type, $expect );
         }
@@ -1032,14 +1042,21 @@ It is suggested you use this in place of eval BLOCK.
 =cut
 
 sub _try {
-    my( $self, $code ) = @_;
+    my( $self, $code, %opts ) = @_;
 
-    local $!;               # eval can mess up $!
-    local $@;               # don't set $@ in the test
-    local $SIG{__DIE__};    # don't trip an outside DIE handler.
-    my $return = eval { $code->() };
+    my $error;
+    my $return;
+    {
+        local $!;               # eval can mess up $!
+        local $@;               # don't set $@ in the test
+        local $SIG{__DIE__};    # don't trip an outside DIE handler.
+        $return = eval { $code->() };
+        $error = $@;
+    }
+
+    die $error if $error and $opts{die_on_fail};
 
-    return wantarray ? ( $return, $@ ) : $return;
+    return wantarray ? ( $return, $error ) : $return;
 }
 
 =end private
@@ -1286,7 +1303,7 @@ sub explain {
     return map {
         ref $_
           ? do {
-            require Data::Dumper;
+            $self->_try(sub { require Data::Dumper }, die_on_fail => 1);
 
             my $dumper = Data::Dumper->new( [$_] );
             $dumper->Indent(1)->Terse(1);
@@ -1327,10 +1344,10 @@ sub _print_to_fh {
 
     # Escape each line after the first with a # so we don't
     # confuse Test::Harness.
-    $msg =~ s/\n(.)/\n# $1/sg;
+    $msg =~ s{\n(?!\z)}{\n# }sg;
 
     # Stick a newline on the end if it needs it.
-    $msg .= "\n" unless $msg =~ /\n\Z/;
+    $msg .= "\n" unless $msg =~ /\n\z/;
 
     return print $fh $msg;
 }
@@ -1825,13 +1842,20 @@ Like the normal caller(), except it reports according to your level().
 
 C<$height> will be added to the level().
 
+If caller() winds up off the top of the stack it report the highest context.
+
 =cut
 
 sub caller {    ## no critic (Subroutines::ProhibitBuiltinHomonyms)
     my( $self, $height ) = @_;
     $height ||= 0;
 
-    my @caller = CORE::caller( $self->level + $height + 1 );
+    my $level = $self->level + $height + 1;
+    my @caller;
+    do {
+        @caller = CORE::caller( $level );
+        $level--;
+    } until @caller;
     return wantarray ? @caller : $caller[0];
 }
 
diff --git a/lib/Test/Builder/Module.pm b/lib/Test/Builder/Module.pm
index c5e36e8..8cbd7a3 100644
--- a/lib/Test/Builder/Module.pm
+++ b/lib/Test/Builder/Module.pm
@@ -8,7 +8,7 @@ use Test::Builder;
 require Exporter;
 our @ISA = qw(Exporter);
 
-our $VERSION = '0.82';
+our $VERSION = '0.85_01';
 
 # 5.004's Exporter doesn't have export_to_level.
 my $_export_to_level = sub {
diff --git a/lib/Test/Builder/Tester.pm b/lib/Test/Builder/Tester.pm
index 772775e..168ef6f 100644
--- a/lib/Test/Builder/Tester.pm
+++ b/lib/Test/Builder/Tester.pm
@@ -2,7 +2,7 @@ package Test::Builder::Tester;
 # $Id: /mirror/googlecode/test-more-trunk/lib/Test/Builder/Tester.pm 67223 2008-10-15T03:08:18.888155Z schwern  $
 
 use strict;
-our $VERSION = "1.15";
+our $VERSION = "1.17_01";
 
 use Test::Builder;
 use Symbol;
diff --git a/lib/Test/More.pm b/lib/Test/More.pm
index 0186397..6c00a8c 100644
--- a/lib/Test/More.pm
+++ b/lib/Test/More.pm
@@ -18,7 +18,7 @@ sub _carp {
     return warn @_, " at $file line $line\n";
 }
 
-our $VERSION = '0.82';
+our $VERSION = '0.85_01';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Builder::Module;
diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm
index 606d7fb..2c3c209 100644
--- a/lib/Test/Simple.pm
+++ b/lib/Test/Simple.pm
@@ -5,7 +5,7 @@ use 5.004;
 
 use strict;
 
-our $VERSION = '0.82';
+our $VERSION = '0.85_01';
 $VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 use Test::Builder::Module;
diff --git a/lib/Test/Simple/Changes b/lib/Test/Simple/Changes
index e28ee89..c89a140 100644
--- a/lib/Test/Simple/Changes
+++ b/lib/Test/Simple/Changes
@@ -1,3 +1,25 @@
+0.85_01  Thu Oct 23 18:57:38 PDT 2008
+    New Features
+    * cmp_ok() now displays the error if the comparison throws one.
+      For example, broken overloaded objects.
+
+    Bug Fixes
+    * cmp_ok() no longer stringifies or numifies its arguments before comparing.
+      This makes cmp_ok() properly test overloaded ops.
+      [rt.cpan.org 24186] [code.google.com 16]
+    * diag() properly escapes blank lines.
+
+    Feature Changes
+    * cmp_ok() now reports warnings and errors as coming from inside cmp_ok,
+      as well as reporting the caller's file and line.  This let's the user
+      know where cmp_ok() was called from while reminding them that it is
+      being run in a different context.
+
+    Other
+    * Dependency on ExtUtils::MakeMaker 6.27 only on Windows otherwise the
+      nested tests won't run.
+
+
 0.84  Wed Oct 15 09:06:12 EDT 2008
     Other
     * 0.82 accidentally shipped with experimental Mouse dependency.
diff --git a/lib/Test/Simple/t/Builder/try.t b/lib/Test/Simple/t/Builder/try.t
index 87a903f..37e0cdf 100644
--- a/lib/Test/Simple/t/Builder/try.t
+++ b/lib/Test/Simple/t/Builder/try.t
@@ -18,19 +18,26 @@ use Test::More 'no_plan';
 require Test::Builder;
 my $tb = Test::Builder->new;
 
-local $SIG{__DIE__} = sub { fail("DIE handler called: @_") };
 
-# These should not change;
-local $@ = 42;
-local $! = 23;
+# Test that _try() has no effect on $@ and $! and is not effected by
+# __DIE__
+{
+    local $SIG{__DIE__} = sub { fail("DIE handler called: @_") };
+    local $@ = 42;
+    local $! = 23;
 
-is $tb->_try(sub { 2 }), 2;
-is $tb->_try(sub { return '' }), '';
+    is $tb->_try(sub { 2 }), 2;
+    is $tb->_try(sub { return '' }), '';
 
-is $tb->_try(sub { die; }), undef;
+    is $tb->_try(sub { die; }), undef;
 
-is_deeply [$tb->_try(sub { die "Foo\n" }, undef)],
-          [undef, "Foo\n"];
+    is_deeply [$tb->_try(sub { die "Foo\n" })], [undef, "Foo\n"];
 
-is $@, 42;
-cmp_ok $!, '==', 23;
+    is $@, 42;
+    cmp_ok $!, '==', 23;
+}
+
+ok !eval {
+    $tb->_try(sub { die "Died\n" }, die_on_fail => 1);
+};
+is $@, "Died\n";
diff --git a/lib/Test/Simple/t/c_flag.t b/lib/Test/Simple/t/c_flag.t
new file mode 100644
index 0000000..a339634
--- /dev/null
+++ b/lib/Test/Simple/t/c_flag.t
@@ -0,0 +1,21 @@
+#!/usr/bin/perl -w
+
+# Test::More should not print anything when Perl is only doing
+# a compile as with the -c flag or B::Deparse or perlcc.
+
+# HARNESS_ACTIVE=1 was causing an error with -c
+{
+    local $ENV{HARNESS_ACTIVE} = 1;
+    local $^C = 1;
+
+    require Test::More;
+    Test::More->import(tests => 1);
+
+    fail("This should not show up");
+}
+
+Test::More->builder->no_ending(1);
+
+print "1..1\n";
+print "ok 1\n";
+
diff --git a/lib/Test/Simple/t/cmp_ok.t b/lib/Test/Simple/t/cmp_ok.t
index 38d412d..05629b6 100644
--- a/lib/Test/Simple/t/cmp_ok.t
+++ b/lib/Test/Simple/t/cmp_ok.t
@@ -30,19 +30,19 @@ sub try_cmp_ok {
     $expect{error} =~ s/ at .*\n?//;
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
-    my $ok = cmp_ok($left, $cmp, $right);
-    $TB->is_num(!!$ok, !!$expect{ok});
+    my $ok = cmp_ok($left, $cmp, $right, "cmp_ok");
+    $TB->is_num(!!$ok, !!$expect{ok}, "  right return");
     
     my $diag = $err->read;
     if( !$ok and $expect{error} ) {
         $diag =~ s/^# //mg;
-        $TB->like( $diag, "/\Q$expect{error}\E/" );
+        $TB->like( $diag, qr/\Q$expect{error}\E/, "  expected error" );
     }
     elsif( $ok ) {
-        $TB->is_eq( $diag, '' );
+        $TB->is_eq( $diag, '', "  passed without diagnostic" );
     }
     else {
-        $TB->ok(1);
+        $TB->ok(1, "  failed without diagnostic");
     }
 }
 
@@ -50,6 +50,10 @@ sub try_cmp_ok {
 use Test::More;
 Test::More->builder->no_ending(1);
 
+require MyOverload;
+my $cmp = Overloaded::Compare->new("foo", 42);
+my $ify = Overloaded::Ify->new("bar", 23);
+
 my @Tests = (
     [1, '==', 1],
     [1, '==', 2],
@@ -57,23 +61,12 @@ my @Tests = (
     ["a", "eq", "a"],
     [1, "+", 1],
     [1, "-", 1],
-);
 
-# These don't work yet.
-if( 0 ) {
-#if( eval { require overload } ) {
-    require MyOverload;
-    
-    my $cmp = Overloaded::Compare->new("foo", 42);
-    my $ify = Overloaded::Ify->new("bar", 23);
-    
-    push @Tests, (
-        [$cmp, '==', 42],
-        [$cmp, 'eq', "foo"],
-        [$ify, 'eq', "bar"],
-        [$ify, "==", 23],
-    );
-}
+    [$cmp, '==', 42],
+    [$cmp, 'eq', "foo"],
+    [$ify, 'eq', "bar"],
+    [$ify, "==", 23],
+);
 
 plan tests => scalar @Tests;
 $TB->plan(tests => @Tests * 2);
diff --git a/lib/Test/Simple/t/diag.t b/lib/Test/Simple/t/diag.t
index 567671e..c6276d9 100644
--- a/lib/Test/Simple/t/diag.t
+++ b/lib/Test/Simple/t/diag.t
@@ -25,49 +25,66 @@ BEGIN {
 
 use strict;
 
-use Test::More tests => 5;
+use Test::More tests => 7;
 
-my $Test = Test::More->builder;
+my $test = Test::Builder->create;
 
 # now make a filehandle where we can send data
 use TieOut;
 my $output = tie *FAKEOUT, 'TieOut';
 
-# force diagnostic output to a filehandle, glad I added this to
-# Test::Builder :)
-my $ret;
-{
-    local $TODO = 1;
-    $Test->todo_output(\*FAKEOUT);
-
-    diag("a single line");
 
-    $ret = diag("multiple\n", "lines");
-}
+# Test diag() goes to todo_output() in a todo test.
+{
+    $test->todo_start();
+    $test->todo_output(\*FAKEOUT);
 
-is( $output->read, <<'DIAG',   'diag() with todo_output set' );
+    $test->diag("a single line");
+    is( $output->read, <<'DIAG',   'diag() with todo_output set' );
 # a single line
+DIAG
+
+    my $ret = $test->diag("multiple\n", "lines");
+    is( $output->read, <<'DIAG',   '  multi line' );
 # multiple
 # lines
 DIAG
+    ok( !$ret, 'diag returns false' );
 
-ok( !$ret, 'diag returns false' );
+    $test->todo_end();
+}
 
+$test->reset_outputs();
+
+
+# Test diagnostic formatting
+$test->failure_output(\*FAKEOUT);
 {
-    $Test->failure_output(\*FAKEOUT);
-    $ret = diag("# foo");
+    $test->diag("# foo");
+    is( $output->read, "# # foo\n", "diag() adds # even if there's one already" );
+
+    $test->diag("foo\n\nbar");
+    is( $output->read, <<'DIAG', "  blank lines get escaped" );
+# foo
+# 
+# bar
+DIAG
+
+
+    $test->diag("foo\n\nbar\n\n");
+    is( $output->read, <<'DIAG', "  even at the end" );
+# foo
+# 
+# bar
+# 
+DIAG
 }
-$Test->failure_output(\*STDERR);
-is( $output->read, "# # foo\n", "diag() adds # even if there's one already" );
-ok( !$ret,  'diag returns false' );
 
 
 # [rt.cpan.org 8392]
 {
-    $Test->failure_output(\*FAKEOUT);
-    diag(qw(one two));
+    $test->diag(qw(one two));
 }
-$Test->failure_output(\*STDERR);
 is( $output->read, <<'DIAG' );
 # onetwo
 DIAG
diff --git a/lib/Test/Simple/t/fail-more.t b/lib/Test/Simple/t/fail-more.t
index 95b04b4..32b0701 100644
--- a/lib/Test/Simple/t/fail-more.t
+++ b/lib/Test/Simple/t/fail-more.t
@@ -291,7 +291,7 @@ ERR
 #     expected: foo
 ERR
     My::Test::like $warnings,
-     qq[/^Argument "foo" isn't numeric in .* at $Filename line 211\\\.\n\$/];
+     qr/^Argument "foo" isn't numeric in .* at cmp_ok \[from $Filename line 211\] line 1\.\n$/;
 
 }
 
diff --git a/lib/Test/Simple/t/is_deeply_dne_bug.t b/lib/Test/Simple/t/is_deeply_dne_bug.t
index c2bff0f..2319c91 100644
--- a/lib/Test/Simple/t/is_deeply_dne_bug.t
+++ b/lib/Test/Simple/t/is_deeply_dne_bug.t
@@ -17,16 +17,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More;
-
-BEGIN {
-    if( !eval "require overload" ) {
-        plan skip_all => "needs overload.pm";
-    }
-    else {
-        plan tests => 2;
-    }
-}
+use Test::More tests => 2;
 
 {
     package Foo;
diff --git a/lib/Test/Simple/t/is_deeply_fail.t b/lib/Test/Simple/t/is_deeply_fail.t
index e374658..5160a10 100644
--- a/lib/Test/Simple/t/is_deeply_fail.t
+++ b/lib/Test/Simple/t/is_deeply_fail.t
@@ -318,7 +318,8 @@ ERR
 ERR
 
 
-    if( eval { require overload } ) {
+    # Overloaded object tests
+    {
 	my $foo = bless [], "Foo";
 	my $bar = bless {}, "Bar";
 
@@ -338,9 +339,6 @@ ERR
 ERR
 
     }
-    else {
-	$TB->skip("Needs overload.pm") for 1..3;
-    }
 }
 
 
diff --git a/lib/Test/Simple/t/no_plan.t b/lib/Test/Simple/t/no_plan.t
index a97f65f..c997990 100644
--- a/lib/Test/Simple/t/no_plan.t
+++ b/lib/Test/Simple/t/no_plan.t
@@ -16,13 +16,13 @@ use Test::More tests => 9;
 my $tb = Test::Builder->create;
 $tb->level(0);
 
-#line 19
+#line 20
 ok !eval { $tb->plan(tests => undef) };
-is($@, "Got an undefined number of tests at $0 line 19.\n");
+is($@, "Got an undefined number of tests at $0 line 20.\n");
 
-#line 23
+#line 24
 ok !eval { $tb->plan(tests => 0) };
-is($@, "You said to run 0 tests at $0 line 23.\n");
+is($@, "You said to run 0 tests at $0 line 24.\n");
 
 #line 28
 ok !eval { $tb->ok(1) };
diff --git a/lib/Test/Simple/t/overload.t b/lib/Test/Simple/t/overload.t
index 0ac5f0e..cd875be 100644
--- a/lib/Test/Simple/t/overload.t
+++ b/lib/Test/Simple/t/overload.t
@@ -12,27 +12,26 @@ BEGIN {
 }
 
 use strict;
-use Test::More;
-
-BEGIN {
-    if( !eval "require overload" ) {
-        plan skip_all => "needs overload.pm";
-    }
-    else {
-        plan tests => 13;
-    }
-}
+use Test::More tests => 15;
 
 
 package Overloaded;
 
 use overload
-        q{""}    => sub { $_[0]->{string} },
-        q{0+}    => sub { $_[0]->{num} };
+  q{eq}    => sub { $_[0]->{string} },
+  q{==}    => sub { $_[0]->{num} },
+  q{""}    => sub { $_[0]->{stringfy}++; $_[0]->{string} },
+  q{0+}    => sub { $_[0]->{numify}++;   $_[0]->{num}    }
+;
 
 sub new {
     my $class = shift;
-    bless { string => shift, num => shift }, $class;
+    bless {
+        string  => shift,
+        num     => shift,
+        stringify       => 0,
+        numify          => 0,
+    }, $class;
 }
 
 
@@ -49,7 +48,9 @@ isa_ok $obj, 'Overloaded';
 
 is $obj, 'foo',            'is() with string overloading';
 cmp_ok $obj, 'eq', 'foo',  'cmp_ok() ...';
+is $obj->{stringify}, 0, 'cmp_ok() eq does not stringify';
 cmp_ok $obj, '==', 42,     'cmp_ok() with number overloading';
+is $obj->{numify}, 0,    'cmp_ok() == does not numify';
 
 is_deeply [$obj], ['foo'],                 'is_deeply with string overloading';
 ok eq_array([$obj], ['foo']),              'eq_array ...';
diff --git a/lib/Test/Simple/t/overload_threads.t b/lib/Test/Simple/t/overload_threads.t
index d02c504..4617a34 100644
--- a/lib/Test/Simple/t/overload_threads.t
+++ b/lib/Test/Simple/t/overload_threads.t
@@ -18,16 +18,7 @@ BEGIN {
     eval { require threads; 'threads'->import; 1; };
 }
 
-use Test::More;
-
-BEGIN {
-    if( !eval "require overload" ) {
-        plan skip_all => "needs overload.pm";
-    }
-    else {
-        plan tests => 5;
-    }
-}
+use Test::More tests => 5;
 
 
 package Overloaded;
diff --git a/lib/Test/Simple/t/undef.t b/lib/Test/Simple/t/undef.t
index 93c77bd..c1f5cee 100644
--- a/lib/Test/Simple/t/undef.t
+++ b/lib/Test/Simple/t/undef.t
@@ -32,7 +32,7 @@ sub warnings_is {
 }
 
 sub warnings_like {
-    $TB->like($warnings, "/$_[0]/");
+    $TB->like($warnings, $_[0]);
     $warnings = '';
 }
 
@@ -54,7 +54,7 @@ Test::More->builder->isnt_num(23, undef,  'isnt_num()');
 
 #line 45
 like( undef, '/.*/',        'undef is like anything' );
-warnings_like("Use of uninitialized value.* at $Filename line 45\\.\n");
+warnings_like(qr/Use of uninitialized value.* at $Filename line 45\.\n/);
 
 eq_array( [undef, undef], [undef, 23] );
 no_warnings;
@@ -74,7 +74,7 @@ no_warnings;
 
 #line 64
 cmp_ok( undef, '<=', 2, '  undef <= 2' );
-warnings_like("Use of uninitialized value.* at $Filename line 64\\.\n");
+warnings_like(qr/Use of uninitialized value.* at cmp_ok \[from $Filename line 64\] line 1\.\n/);