use strict;
use vars qw($VERSION);
-$VERSION = '0.33';
+$VERSION = '0.33_02';
$VERSION = eval $VERSION; # make the alpha version come out as a number
# Make Test::Builder thread-safe for ithreads.
BEGIN {
use Config;
- # Load threads::shared when threads are turned on
- if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) {
+ # Load threads::shared when threads are turned on.
+ # 5.8.0's threads are so busted we no longer support them.
+ if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'}) {
require threads::shared;
# Hack around YET ANOTHER threads::shared bug. It would
$$data = ${$_[0]};
}
else {
- die "Unknown type: ".$type;
+ die("Unknown type: ".$type);
}
$_[0] = &threads::shared::share($_[0]);
${$_[0]} = $$data;
}
else {
- die "Unknown type: ".$type;
+ die("Unknown type: ".$type);
}
return $_[0];
};
}
- # 5.8.0's threads::shared is busted when threads are off.
- # We emulate it here.
+ # 5.8.0's threads::shared is busted when threads are off
+ # and earlier Perls just don't have that module at all.
else {
*share = sub { return $_[0] };
*lock = sub { 0 };
return unless $cmd;
if( $self->{Have_Plan} ) {
- die sprintf "You tried to plan twice! Second plan at %s line %d\n",
- ($self->caller)[1,2];
+ $self->croak("You tried to plan twice");
}
if( $cmd eq 'no_plan' ) {
}
elsif( $cmd eq 'tests' ) {
if( $arg ) {
+ local $Level = $Level + 1;
return $self->expected_tests($arg);
}
elsif( !defined $arg ) {
- die "Got an undefined number of tests. Looks like you tried to ".
- "say how many tests you plan to run but made a mistake.\n";
+ $self->croak("Got an undefined number of tests");
}
elsif( !$arg ) {
- die "You said to run 0 tests! You've got to run something.\n";
+ $self->croak("You said to run 0 tests");
}
}
else {
- require Carp;
my @args = grep { defined } ($cmd, $arg);
- Carp::croak("plan() doesn't understand @args");
+ $self->croak("plan() doesn't understand @args");
}
return 1;
my($max) = @_;
if( @_ ) {
- die "Number of tests must be a postive integer. You gave it '$max'.\n"
+ $self->croak("Number of tests must be a positive integer. You gave it '$max'")
unless $max =~ /^\+?\d+$/ and $max > 0;
$self->{Expected_Tests} = $max;
# store, so we turn it into a boolean.
$test = $test ? 1 : 0;
- unless( $self->{Have_Plan} ) {
- require Carp;
- Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
- }
+ $self->_plan_check;
lock $self->{Curr_Test};
$self->{Curr_Test}++;
if( defined $name ) {
$self->diag(qq[ $msg test '$name'\n]);
- $self->diag(qq[ in $file at line $line.\n]);
+ $self->diag(qq[ at $file line $line.\n]);
}
else {
- $self->diag(qq[ $msg test in $file at line $line.\n]);
+ $self->diag(qq[ $msg test at $file line $line.\n]);
}
}
$why ||= '';
$self->_unoverload_str(\$why);
- unless( $self->{Have_Plan} ) {
- require Carp;
- Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
- }
+ $self->_plan_check;
lock($self->{Curr_Test});
$self->{Curr_Test}++;
my($self, $why) = @_;
$why ||= '';
- unless( $self->{Have_Plan} ) {
- require Carp;
- Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
- }
+ $self->_plan_check;
lock($self->{Curr_Test});
$self->{Curr_Test}++;
print $fh $msg;
}
+=begin private
=item B<_print_diag>
Like _print, but prints to the current diagnostic filehandle.
+=end private
+
=cut
sub _print_diag {
my($self, $fh) = @_;
if( defined $fh ) {
- $self->{Out_FH} = _new_fh($fh);
+ $self->{Out_FH} = $self->_new_fh($fh);
}
return $self->{Out_FH};
}
my($self, $fh) = @_;
if( defined $fh ) {
- $self->{Fail_FH} = _new_fh($fh);
+ $self->{Fail_FH} = $self->_new_fh($fh);
}
return $self->{Fail_FH};
}
my($self, $fh) = @_;
if( defined $fh ) {
- $self->{Todo_FH} = _new_fh($fh);
+ $self->{Todo_FH} = $self->_new_fh($fh);
}
return $self->{Todo_FH};
}
sub _new_fh {
+ my $self = shift;
my($file_or_fh) = shift;
my $fh;
- if( _is_fh($file_or_fh) ) {
+ if( $self->_is_fh($file_or_fh) ) {
$fh = $file_or_fh;
}
else {
$fh = do { local *FH };
- open $fh, ">$file_or_fh" or
- die "Can't open test output log $file_or_fh: $!";
+ open $fh, ">$file_or_fh" or
+ $self->croak("Can't open test output log $file_or_fh: $!");
_autoflush($fh);
}
sub _is_fh {
+ my $self = shift;
my $maybe_fh = shift;
return 0 unless defined $maybe_fh;
}
+=item carp
+
+ $tb->carp(@message);
+
+Warns with C<@message> but the message will appear to come from the
+point where the original test function was called (C<$tb->caller>).
+
+=item croak
+
+ $tb->croak(@message);
+
+Dies with C<@message> but the message will appear to come from the
+point where the original test function was called (C<$tb->caller>).
+
+=cut
+
+sub _message_at_caller {
+ my $self = shift;
+
+ local $Level = $Level + 2;
+ my($pack, $file, $line) = $self->caller;
+ return join("", @_) . " at $file line $line.\n";
+}
+
+sub carp {
+ my $self = shift;
+ warn $self->_message_at_caller(@_);
+}
+
+sub croak {
+ my $self = shift;
+ die $self->_message_at_caller(@_);
+}
+
+sub _plan_check {
+ my $self = shift;
+
+ unless( $self->{Have_Plan} ) {
+ local $Level = $Level + 1;
+ $self->croak("You tried to run a test without a plan");
+ }
+}
+
=back
lock($self->{Curr_Test});
if( defined $num ) {
unless( $self->{Have_Plan} ) {
- require Carp;
- Carp::croak("Can't change the current test number without a plan!");
+ $self->croak("Can't change the current test number without a plan!");
}
$self->{Curr_Test} = $num;
sub _sanity_check {
my $self = shift;
- _whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!');
- _whoa(!$self->{Have_Plan} and $self->{Curr_Test},
+ $self->_whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!');
+ $self->_whoa(!$self->{Have_Plan} and $self->{Curr_Test},
'Somehow your tests ran without a plan!');
- _whoa($self->{Curr_Test} != @{ $self->{Test_Results} },
+ $self->_whoa($self->{Curr_Test} != @{ $self->{Test_Results} },
'Somehow you got a different number of results than tests ran!');
}
=item B<_whoa>
- _whoa($check, $description);
+ $self->_whoa($check, $description);
A sanity check, similar to assert(). If the $check is true, something
has gone horribly wrong. It will die with the given $description and
=cut
sub _whoa {
- my($check, $desc) = @_;
+ my($self, $check, $desc) = @_;
if( $check ) {
- die <<WHOA;
+ local $Level = $Level + 1;
+ $self->croak(<<"WHOA");
WHOA! $desc
This should never happen! Please contact the author immediately!
WHOA
=head1 THREADS
-In perl 5.8.0 and later, Test::Builder is thread-safe. The test
+In perl 5.8.1 and later, Test::Builder is thread-safe. The test
number is shared amongst all threads. This means if one thread sets
the test number using current_test() they will all be effected.
+While versions earlier than 5.8.1 had threads they contain too many
+bugs to support.
+
Test::Builder is only thread-aware if threads.pm is loaded I<before>
Test::Builder.
require Exporter;
@ISA = qw(Exporter);
-$VERSION = '0.03';
+$VERSION = '0.03_02';
use strict;
use strict;
use vars qw(@EXPORT $VERSION @ISA);
-$VERSION = "1.04";
+$VERSION = "1.04_02";
use Test::Builder;
use Symbol;
my @checks = @_;
foreach my $check (@checks) {
$check = $self->_translate_Failed_check($check);
- push @{$self->[2]}, ref $check ? $check : "$check\n";
+ push @{$self->{wanted}}, ref $check ? $check : "$check\n";
}
}
-sub _translate_Failed_check
+sub _translate_Failed_check
{
my($self, $check) = @_;
if( $check =~ /\A(.*)# (Failed .*test) \((.*?) at line (\d+)\)\z/ ) {
- $check = qr/\Q$1\E#\s+\Q$2\E.*?\n?.*?\Q$3\E at line \Q$4\E.*\n?/;
+ $check = qr/\Q$1\E#\s+\Q$2\E.*?\n?.*?\Qat $3\E line \Q$4\E.*\n?/;
}
return $check;
# turn off warnings as these might be undef
local $^W = 0;
- my @checks = @{$self->[2]};
- my $got = $self->[1];
+ my @checks = @{$self->{wanted}};
+ my $got = $self->{got};
foreach my $check (@checks) {
$check = qr/^\Q$check\E/ unless ref $check;
return 0 unless $got =~ s/^$check//;
sub reset
{
my $self = shift;
- @$self = ($self->[0], '', []);
+ %$self = (
+ type => $self->{type},
+ got => '',
+ wanted => [],
+ );
}
sub got
{
my $self = shift;
- return $self->[1];
+ return $self->{got};
}
sub wanted
{
my $self = shift;
- return $self->[2];
+ return $self->{wanted};
}
sub type
{
my $self = shift;
- return $self->[0];
+ return $self->{type};
}
###
sub PRINT {
my $self = shift;
- $self->[1] .= join '', @_;
+ $self->{got} .= join '', @_;
}
sub TIEHANDLE {
my($class, $type) = @_;
- my $self = bless [$type], $class;
+ my $self = bless {
+ type => $type
+ }, $class;
+
$self->reset;
return $self;
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.64';
+$VERSION = '0.64_02';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
=head1 SYNOPSIS
- use Test::More tests => $Num_Tests;
+ use Test::More tests => 23;
# or
use Test::More qw(no_plan);
# or
The preferred way to do this is to declare a plan when you C<use Test::More>.
- use Test::More tests => $Num_Tests;
+ use Test::More tests => 23;
There are rare cases when you will not know beforehand how many tests
your script is going to run. In this case, you can declare that you
use Test::More
use threads;
+5.8.1 and above are supported. Anything below that has too many bugs.
+
=item Test::Harness upgrade
use strict 'vars';
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.64';
+$VERSION = '0.64_02';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
+0.64_02 Sat Sep 9 12:16:56 EDT 2006
+ - Last release broke Perls earlier than 5.8.
+
+0.64_01 Mon Sep 4 04:40:42 EDT 2006
+ - Small improvement to the docs to avoid user confusion over
+ "use Test::More tests => $num_tests" (Thanks Eric Wilhelm)
+ - Minor fix for a test failure in is_deeply_fail for some Windows
+ users. Not a real bug. [rt.cpan.org 21310]
+ - _print_diag() accidentally leaked into the public documentation.
+ It is a private method.
+ * Made most of the error messages report in the caller's context.
+ [rt.cpan.org #20639]
+ * Made the failure diagnostic message file and line reporting portion
+ match Perl's for easier integration with Perl aware editors.
+ (so its "at $file line $line_num." now)
+ [rt.cpan.org #20639]
+ * 5.8.0 threads are no longer supported. There's too many bugs.
+
0.64 Sun Jul 16 02:47:29 PDT 2006
* 0.63's change to test_fail() broke backwards compatibility. They
have been removed for the time being. test_pass() went with it.
my $TH_Version = 2.03;
require Test::Harness;
-unless( cmp_ok( $Test::Harness::VERSION, '>', $TH_Version, "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
# lots of threading bugs.
use Config;
BEGIN {
- if( $] >= 5.008 && $Config{useithreads} ) {
+ if( $] >= 5.008001 && $Config{useithreads} ) {
require threads;
'threads'->import;
}
$TB->is_eq($$err, <<ERR);
# Failed test 'Bar'
-# in $0 at line 31.
+# at $0 line 31.
# Failed test 'Sar'
-# in $0 at line 34.
+# at $0 line 34.
# Looks like you planned 3 tests but ran 2 extra.
# Looks like you failed 2 tests of 5 run.
ERR
my $err_re = <<ERR;
# Failed test 'is foo like that'
-# in .* at line 1\.
+# at .* line 1\.
# 'foo'
# doesn't match '\\(\\?-xism:that\\)'
# Looks like you failed 1 test of 1\\.
ok( 0, 'failing' );
err_ok( <<ERR );
# Failed test 'failing'
-# in $0 at line 38.
+# at $0 line 38.
ERR
#line 40
is( '', 0, 'empty string is 0?' );
err_ok( <<ERR );
# Failed test 'foo is bar?'
-# in $0 at line 40.
+# at $0 line 40.
# got: 'foo'
# expected: 'bar'
# Failed test 'undef is empty string?'
-# in $0 at line 41.
+# at $0 line 41.
# got: undef
# expected: ''
# Failed test 'undef is 0?'
-# in $0 at line 42.
+# at $0 line 42.
# got: undef
# expected: '0'
# Failed test 'empty string is 0?'
-# in $0 at line 43.
+# at $0 line 43.
# got: ''
# expected: '0'
ERR
isnt(undef, undef, 'undef isnt undef?');
err_ok( <<ERR );
# Failed test 'foo isnt foo?'
-# in $0 at line 45.
+# at $0 line 45.
# 'foo'
# ne
# 'foo'
# Failed test 'foo isn\'t foo?'
-# in $0 at line 46.
+# at $0 line 46.
# 'foo'
# ne
# 'foo'
# Failed test 'undef isnt undef?'
-# in $0 at line 47.
+# at $0 line 47.
# undef
# ne
# undef
unlike( "foo", '/foo/', 'is foo unlike foo' );
err_ok( <<ERR );
# Failed test 'is foo like that'
-# in $0 at line 48.
+# at $0 line 48.
# 'foo'
# doesn't match '/that/'
# Failed test 'is foo unlike foo'
-# in $0 at line 49.
+# at $0 line 49.
# 'foo'
# matches '/foo/'
ERR
like( "bug", '/(%)/', 'regex with % in it' );
err_ok( <<ERR );
# Failed test 'regex with % in it'
-# in $0 at line 60.
+# at $0 line 60.
# 'bug'
# doesn't match '/(%)/'
ERR
fail('fail()');
err_ok( <<ERR );
# Failed test 'fail()'
-# in $0 at line 67.
+# at $0 line 67.
ERR
#line 52
can_ok(undef, undef);
err_ok( <<ERR );
# Failed test 'Mooble::Hooble::Yooble->can(...)'
-# in $0 at line 52.
+# at $0 line 52.
# Mooble::Hooble::Yooble->can('this') failed
# Mooble::Hooble::Yooble->can('that') failed
# Failed test 'Mooble::Hooble::Yooble->can(...)'
-# in $0 at line 53.
+# at $0 line 53.
# can_ok() called with no methods
# Failed test '->can(...)'
-# in $0 at line 54.
+# at $0 line 54.
# can_ok() called with empty class or reference
ERR
isa_ok([], "HASH");
err_ok( <<ERR );
# Failed test 'The object isa Wibble'
-# in $0 at line 55.
+# at $0 line 55.
# The object isn't a 'Wibble' it's a 'Foo'
# Failed test 'My Wibble isa Wibble'
-# in $0 at line 56.
+# at $0 line 56.
# My Wibble isn't a reference
# Failed test 'Another Wibble isa Wibble'
-# in $0 at line 57.
+# at $0 line 57.
# Another Wibble isn't defined
# Failed test 'The object isa HASH'
-# in $0 at line 58.
+# at $0 line 58.
# The object isn't a 'HASH' it's a 'ARRAY'
ERR
cmp_ok( 1, '&&', 0 , ' &&' );
err_ok( <<ERR );
# Failed test 'cmp_ok eq'
-# in $0 at line 68.
+# at $0 line 68.
# got: 'foo'
# expected: 'bar'
# Failed test ' =='
-# in $0 at line 69.
+# at $0 line 69.
# got: 42.1
# expected: 23
# Failed test ' !='
-# in $0 at line 70.
+# at $0 line 70.
# '42'
# !=
# '42'
# Failed test ' &&'
-# in $0 at line 71.
+# at $0 line 71.
# '1'
# &&
# '0'
cmp_ok( 42, 'eq', "foo", ' eq with numbers' );
err_ok( <<ERR );
# Failed test ' eq with numbers'
-# in $0 at line 196.
+# at $0 line 196.
# got: '42'
# expected: 'foo'
ERR
cmp_ok( 42, '==', "foo", ' == with strings' );
err_ok( <<ERR );
# Failed test ' == with strings'
-# in $0 at line 211.
+# at $0 line 211.
# got: 42
# expected: foo
ERR
cmp_ok( $!, '==', -1, ' eq with numerified errno' );
err_ok( <<ERR );
# Failed test ' eq with stringified errno'
-# in $0 at line 80.
+# at $0 line 80.
# got: '$Errno_String'
# expected: ''
# Failed test ' eq with numerified errno'
-# in $0 at line 81.
+# at $0 line 81.
# got: $Errno_Number
# expected: -1
ERR
my $more_err_re = <<ERR;
# Failed test 'use Hooble::mooble::yooble;'
-# in $Filename at line 84\\.
+# at $Filename line 84\\.
# Tried to use 'Hooble::mooble::yooble'.
# Error: Can't locate Hooble.* in \\\@INC .*
# BEGIN failed--compilation aborted at $Filename line 84.
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\\.
+# at $Filename line 85\\.
# Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
# Error: Can't locate ALL.* in \\\@INC .*
ERR
My::Test::ok($$err eq <<ERR);
# Failed test 'oh no!'
-# in $0 at line 38.
+# at $0 line 38.
# Failed test 'damnit'
-# in $0 at line 39.
+# at $0 line 39.
# Looks like you failed 2 tests of 5.
ERR
OUT
My::Test::ok($$err eq <<ERR) || print $$err;
-# Failed test in $0 at line 45.
+# Failed test at $0 line 45.
# Looks like you failed 1 test of 1.
ERR
fail( "this fails" );
err_ok( <<ERR );
# Failed test 'this fails'
-# in $0 at line 62.
+# at $0 line 62.
ERR
#line 72
is( 1, 0 );
err_ok( <<ERR );
-# Failed test in $0 at line 72.
+# Failed test at $0 line 72.
# got: '1'
# expected: '0'
ERR
err_ok( <<ERR );
# Failed test 'this fails'
-# in $0 at line 71.
+# at $0 line 71.
ERR
is( 1, 0 );
err_ok( <<ERR );
-# Failed test in $0 at line 84.
+# Failed test at $0 line 84.
# got: '1'
# expected: '0'
ERR
is( $out, "not ok 1 - plain strings\n", 'plain strings' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'plain strings'
-# in $0 at line 68.
+# at $0 line 68.
# got: 'foo'
# expected: 'bar'
ERR
is( $out, "not ok 2 - different types\n", 'different types' );
like( $err, <<ERR, ' right diagnostic' );
# Failed test 'different types'
-# in $Filename at line 78.
+# at $Filename line 78.
# Structures begin differing at:
# \\\$got = HASH\\(0x[0-9a-f]+\\)
# \\\$expected = ARRAY\\(0x[0-9a-f]+\\)
'hashes with different values' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'hashes with different values'
-# in $0 at line 88.
+# at $0 line 88.
# Structures begin differing at:
# \$got->{this} = '42'
# \$expected->{this} = '43'
'hashes with different keys' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'hashes with different keys'
-# in $0 at line 99.
+# at $0 line 99.
# Structures begin differing at:
# \$got->{this} = Does not exist
# \$expected->{this} = '42'
'arrays of different length' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'arrays of different length'
-# in $0 at line 110.
+# at $0 line 110.
# Structures begin differing at:
# \$got->[9] = Does not exist
# \$expected->[9] = '10'
is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'arrays of undefs'
-# in $0 at line 121.
+# at $0 line 121.
# Structures begin differing at:
# \$got->[1] = undef
# \$expected->[1] = Does not exist
is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'hashes of undefs'
-# in $0 at line 131.
+# at $0 line 131.
# Structures begin differing at:
# \$got->{foo} = undef
# \$expected->{foo} = Does not exist
is( $out, "not ok 8 - scalar refs\n", 'scalar refs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'scalar refs'
-# in $0 at line 141.
+# at $0 line 141.
# Structures begin differing at:
# \${ \$got} = '42'
# \${\$expected} = '23'
'mixed scalar and array refs' );
like( $err, <<ERR, ' right diagnostic' );
# Failed test 'mixed scalar and array refs'
-# in $Filename at line 151.
+# at $Filename line 151.
# Structures begin differing at:
# \\\$got = ARRAY\\(0x[0-9a-f]+\\)
# \\\$expected = SCALAR\\(0x[0-9a-f]+\\)
is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'deep scalar refs'
-# in $0 at line 173.
+# at $0 line 173.
# Structures begin differing at:
# \${\${ \$got}} = '42'
# \${\${\$expected}} = '23'
is( $out, "not ok 11 - deep structures\n", 'deep structures' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'deep structures'
-# in $0 at line 198.
+# at $0 line 198.
# Structures begin differing at:
# \$got->{that}{foo} = Does not exist
# \$expected->{that}{foo} = '42'
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 in $0 at line 274.
+# Failed test at $0 line 274.
# Structures begin differing at:
# \$got->[1] = 'b'
# \$expected->[1] = 'c'
ok !is_deeply( 23, $ref );
is( $out, "not ok 21\n", 'scalar vs ref' );
is( $err, <<ERR, ' right diagnostic');
-# Failed test in $0 at line 286.
+# Failed test at $0 line 286.
# Structures begin differing at:
# \$got = '23'
# \$expected = $ref
ok !is_deeply( $ref, 23 );
is( $out, "not ok 22\n", 'ref vs scalar' );
is( $err, <<ERR, ' right diagnostic');
-# Failed test in $0 at line 296.
+# Failed test at $0 line 296.
# Structures begin differing at:
# \$got = $ref
# \$expected = '23'
ok !is_deeply( undef, [] );
is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' );
like( $err, <<ERR, ' right diagnostic' );
-# Failed test in $Filename at line 306\\.
+# Failed test at $Filename line 306\\.
# Structures begin differing at:
# \\\$got = undef
# \\\$expected = ARRAY\\(0x[0-9a-f]+\\)
ok !is_deeply( $array, $hash );
is( $out, "not ok 24\n", 'is_deeply and different reference types' );
is( $err, <<ERR, ' right diagnostic' );
-# Failed test in $0 at line 321.
+# Failed test at $0 line 321.
# Structures begin differing at:
# \$got = $array
# \$expected = $hash
ok !is_deeply( [$array], [$hash] );
is( $out, "not ok 25\n", 'nested different ref types' );
is( $err, <<ERR, ' right diagnostic' );
-# Failed test in $0 at line 332.
+# Failed test at $0 line 332.
# Structures begin differing at:
# \$got->[0] = $array
# \$expected->[0] = $hash
ok !is_deeply( [$foo], [$bar] );
is( $out, "not ok 26\n", 'string overloaded refs respected in diag' );
is( $err, <<ERR, ' right diagnostic' );
-# Failed test in $0 at line 353.
+# Failed test at $0 line 353.
# Structures begin differing at:
# \$got->[0] = $foo
# \$expected->[0] = 'wibble'
ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs';
is( $out, "not ok 27\n" );
like( $err, <<ERR, ' right diagnostic' );
-# Failed test in $Filename at line 349.
+# Failed test at $Filename line 349.
# Structures begin differing at:
# \\\$got = CODE\\(0x[0-9a-f]+\\)
# \\\$expected = CODE\\(0x[0-9a-f]+\\)
ok !is_deeply( $glob1, $glob2 ), 'typeglobs';
is( $out, "not ok 28\n" );
like( $err, <<ERR, ' right diagnostic' );
-# Failed test in $Filename at line 357.
+# Failed test at $Filename line 357.
# Structures begin differing at:
# \\\$got = GLOB\\(0x[0-9a-f]+\\)
# \\\$expected = GLOB\\(0x[0-9a-f]+\\)
use Test::More tests => 8;
use TieOut;
-ok( !Test::Builder::_is_fh("foo"), 'string is not a filehandle' );
-ok( !Test::Builder::_is_fh(''), 'empty string' );
-ok( !Test::Builder::_is_fh(undef), 'undef' );
+ok( !Test::Builder->_is_fh("foo"), 'string is not a filehandle' );
+ok( !Test::Builder->_is_fh(''), 'empty string' );
+ok( !Test::Builder->_is_fh(undef), 'undef' );
ok( open(FILE, '>foo') );
END { close FILE; unlink 'foo' }
-ok( Test::Builder::_is_fh(*FILE) );
-ok( Test::Builder::_is_fh(\*FILE) );
-ok( Test::Builder::_is_fh(*FILE{IO}) );
+ok( Test::Builder->_is_fh(*FILE) );
+ok( Test::Builder->_is_fh(\*FILE) );
+ok( Test::Builder->_is_fh(*FILE{IO}) );
tie *OUT, 'TieOut';
-ok( Test::Builder::_is_fh(*OUT) );
+ok( Test::Builder->_is_fh(*OUT) );
My::Test::is($$err, <<ERR);
# Failed test 'Bar'
-# in $0 at line 31.
+# at $0 line 31.
# Looks like you planned 5 tests but only ran 2.
# Looks like you failed 1 test of 2 run.
ERR
+#!/usr/bin/perl -w
+
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
}
}
-# 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++;
-}
-
-
-package main;
-
-require Test::Simple;
-
-require Test::Simple::Catch;
-my($out, $err) = Test::Simple::Catch::caught();
+use Test::More tests => 6;
-eval {
- Test::Simple->import;
-};
+my $tb = Test::Builder->create;
+$tb->level(0);
-My::Test::ok($$out eq '');
-My::Test::ok($$err eq '');
-My::Test::ok($@ eq '');
+#line 19
+ok !eval { $tb->plan(tests => undef) };
+is($@, "Got an undefined number of tests at $0 line 19.\n");
-eval {
- Test::Simple->import(tests => undef);
-};
+#line 23
+ok !eval { $tb->plan(tests => 0) };
+is($@, "You said to run 0 tests at $0 line 23.\n");
-My::Test::ok($$out eq '');
-My::Test::ok($$err eq '');
-My::Test::ok($@ =~ /Got an undefined number of tests/);
-
-eval {
- Test::Simple->import(tests => 0);
-};
-
-My::Test::ok($$out eq '');
-My::Test::ok($$err eq '');
-My::Test::ok($@ =~ /You said to run 0 tests!/);
-
-eval {
- Test::Simple::ok(1);
-};
-My::Test::ok( $@ =~ /You tried to run a test without a plan!/);
-
-
-END {
- My::Test::ok($$out eq '');
- My::Test::ok($$err eq "");
-
- # Prevent Test::Simple from exiting with non zero.
- exit 0;
-}
+#line 27
+ok !eval { $tb->ok(1) };
+is( $@, "You tried to run a test without a plan at $0 line 27.\n");
plan tests => 4;
eval { plan tests => 4 };
-like( $@, '/^You tried to plan twice!/', 'disallow double plan' );
+is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ - 1),
+ 'disallow double plan' );
eval { plan 'no_plan' };
-like( $@, '/^You tried to plan twice!/', 'disallow chaning plan' );
+is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ -1),
+ 'disallow changing plan' );
pass('Just testing plan()');
pass('Testing it some more');
}
-# Can't use Test.pm, that's a 5.005 thing.
-package My::Test;
+use Test::More tests => 10;
+use Test::Builder;
+my $tb = Test::Builder->create;
+$tb->level(0);
-print "1..7\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;
-}
-
-
-sub is ($$;$) {
- my($this, $that, $name) = @_;
- my $test = $this eq $that;
- my $ok = '';
- $ok .= "not " unless $test;
- $ok .= "ok $test_num";
- $ok .= " - $name" if defined $name;
- $ok .= "\n";
- print $ok;
-
- unless( $test ) {
- print "# got \n$this";
- print "# expected \n$that";
- }
- $test_num++;
-
- return $test;
-}
-
-
-use Test::More import => ['plan'];
-
-ok !eval { plan tests => 'no_plan'; };
-is $@, "Number of tests must be a postive integer. You gave it 'no_plan'.\n";
+ok !eval { $tb->plan( tests => 'no_plan' ); };
+is $@, sprintf "Number of tests must be a positive integer. You gave it 'no_plan' at %s line %d.\n", $0, __LINE__ - 1;
my $foo = [];
my @foo = ($foo, 2, 3);
-ok !eval { plan tests => @foo };
-is $@, "Number of tests must be a postive integer. You gave it '$foo'.\n";
+ok !eval { $tb->plan( tests => @foo ) };
+is $@, sprintf "Number of tests must be a positive integer. You gave it '$foo' at %s line %d.\n", $0, __LINE__ - 1;
+
+#line 25
+ok !eval { $tb->plan( tests => -1 ) };
+is $@, "Number of tests must be a positive integer. You gave it '-1' at $0 line 25.\n";
+
+#line 29
+ok !eval { $tb->plan( tests => '' ) };
+is $@, "You said to run 0 tests at $0 line 29.\n";
-ok !eval { plan tests => 0 };
-ok !eval { plan tests => -1 };
-ok !eval { plan tests => '' };
+#line 33
+ok !eval { $tb->plan( 'wibble' ) };
+is $@, "plan() doesn't understand wibble at $0 line 33.\n";
pass "This does not run";
}
- like $warning, qr/^skip\(\) was passed a non-numeric number of tests/;
+ like $warning, '/^skip\(\) was passed a non-numeric number of tests/';
}
use Config;
BEGIN {
- unless ( $] >= 5.008 && $Config{'useithreads'} &&
+ unless ( $] >= 5.008001 && $Config{'useithreads'} &&
eval { require threads; 'threads'->import; 1; })
{
- print "1..0 # Skip: no threads\n";
+ print "1..0 # Skip: no working threads\n";
exit 0;
}
}
use Config;
BEGIN {
- unless ( $] >= 5.008 && $Config{'useithreads'} &&
+ unless ( $] >= 5.008001 && $Config{'useithreads'} &&
eval { require threads; 'threads'->import; 1; })
{
- print "1..0 # Skip: no threads\n";
+ print "1..0 # Skip: no working threads\n";
exit 0;
}
}
projects / p5sagit/p5-mst-13.2.git / commitdiff