From 82d700dc3bcb588c96407260d728895940e2cf09 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Fri, 7 Nov 2008 10:32:32 +0000 Subject: [PATCH] Upgrade to Test-Simple-0.85_01, keeping local changes 34491 and 34545 p4raw-id: //depot/perl@34761 --- MANIFEST | 1 + lib/Test/Builder.pm | 80 +++++++++++++++++++++++------------ lib/Test/Builder/Module.pm | 2 +- lib/Test/Builder/Tester.pm | 2 +- lib/Test/More.pm | 2 +- lib/Test/Simple.pm | 2 +- lib/Test/Simple/Changes | 22 ++++++++++ lib/Test/Simple/t/Builder/try.t | 29 ++++++++----- lib/Test/Simple/t/c_flag.t | 21 +++++++++ lib/Test/Simple/t/cmp_ok.t | 35 ++++++--------- lib/Test/Simple/t/diag.t | 61 ++++++++++++++++---------- lib/Test/Simple/t/fail-more.t | 2 +- lib/Test/Simple/t/is_deeply_dne_bug.t | 11 +---- lib/Test/Simple/t/is_deeply_fail.t | 6 +-- lib/Test/Simple/t/no_plan.t | 8 ++-- lib/Test/Simple/t/overload.t | 27 ++++++------ lib/Test/Simple/t/overload_threads.t | 11 +---- lib/Test/Simple/t/undef.t | 6 +-- 18 files changed, 197 insertions(+), 131 deletions(-) create mode 100644 lib/Test/Simple/t/c_flag.t 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/); -- 2.7.4