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
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.
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) ) {
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;
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 );
}
=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
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);
# 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;
}
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];
}
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 {
# $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;
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;
use strict;
-our $VERSION = '0.82';
+our $VERSION = '0.85_01';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
+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.
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";
--- /dev/null
+#!/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";
+
$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");
}
}
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],
["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);
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
# 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$/;
}
}
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;
ERR
- if( eval { require overload } ) {
+ # Overloaded object tests
+ {
my $foo = bless [], "Foo";
my $bar = bless {}, "Bar";
ERR
}
- else {
- $TB->skip("Needs overload.pm") for 1..3;
- }
}
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) };
}
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;
}
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 ...';
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;
}
sub warnings_like {
- $TB->like($warnings, "/$_[0]/");
+ $TB->like($warnings, $_[0]);
$warnings = '';
}
#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;
#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/);
projects / p5sagit/p5-mst-13.2.git / commitdiff