cpan/Test-Simple/t/lib/Test/Simple/sample_tests/extras.plx for exit.t
cpan/Test-Simple/t/lib/Test/Simple/sample_tests/five_fail.plx for exit.t
cpan/Test-Simple/t/lib/Test/Simple/sample_tests/last_minute_death.plx for exit.t
+cpan/Test-Simple/t/lib/Test/Simple/sample_tests/missing_done_testing.plx for exit.t
cpan/Test-Simple/t/lib/Test/Simple/sample_tests/one_fail.plx for exit.t
+cpan/Test-Simple/t/lib/Test/Simple/sample_tests/one_fail_without_plan.plx for exit.t
cpan/Test-Simple/t/lib/Test/Simple/sample_tests/pre_plan_death.plx for exit.t
cpan/Test-Simple/t/lib/Test/Simple/sample_tests/require.plx for exit.t
cpan/Test-Simple/t/lib/Test/Simple/sample_tests/success.plx for exit.t
cpan/Test-Simple/t/skipall.t Test::More test, skip all tests
cpan/Test-Simple/t/skip.t Test::More test, SKIP tests
cpan/Test-Simple/t/subtest/args.t Test::More test
+cpan/Test-Simple/t/subtest/bail_out.t Test::More test
cpan/Test-Simple/t/subtest/basic.t Test::More test
cpan/Test-Simple/t/subtest/die.t Test::More test
cpan/Test-Simple/t/subtest/do.t Test::More test
cpan/Test-Simple/t/subtest/plan.t Test::Builder tests
cpan/Test-Simple/t/subtest/predicate.t Test::Builder tests
cpan/Test-Simple/t/subtest/singleton.t Test::More test
+cpan/Test-Simple/t/subtest/threads.t Test::More test
cpan/Test-Simple/t/subtest/todo.t Test::Builder tests
cpan/Test-Simple/t/subtest/wstat.t Test::More test
cpan/Test-Simple/t/tbm_doesnt_set_exported_to.t Test::Builder::Module test
cpan/Test-Simple/t/Tester/tbt_05faildiag.t Test::Builder::Tester test
cpan/Test-Simple/t/Tester/tbt_06errormess.t Test::Builder::Tester test
cpan/Test-Simple/t/Tester/tbt_07args.t Test::Builder::Tester test
+cpan/Test-Simple/t/Tester/tbt_08subtest.t Test::Builder::Tester test
+cpan/Test-Simple/t/Tester/tbt_09do_script.pl Test::Builder::Tester test
+cpan/Test-Simple/t/Tester/tbt_09do.t Test::Builder::Tester test
cpan/Test-Simple/t/threads.t Test::Builder thread-safe checks
cpan/Test-Simple/t/thread_taint.t Test::Simple test
cpan/Test-Simple/t/todo.t Test::More test, TODO tests
},
'Test::Simple' => {
- 'DISTRIBUTION' => 'MSCHWERN/Test-Simple-0.98.tar.gz',
+ 'DISTRIBUTION' => 'RJBS/Test-Simple-0.99.tar.gz',
'FILES' => q[cpan/Test-Simple],
'EXCLUDED' => [
qw( .perlcriticrc
lib/Test/Builder/IO/Scalar.pm
),
],
-
- 'CUSTOMIZED' => [
- # Waiting to be merged upstream: see CPAN RT#79762
- 't/fail-more.t',
-
- # Waiting to be merged upstream: see PERL RT#119825
- 'lib/Test/Builder.pm',
- 'lib/Test/Builder/Module.pm',
- 'lib/Test/More.pm',
- 'lib/Test/Simple.pm',
- ],
-
'UPSTREAM' => 'cpan',
},
+0.99 Sat Oct 12 15:05:41 EDT 2013
+ * no changes since 0.98_06
+
+0.98_06 Fri Sep 27 10:11:05 EDT 2013
+ Bug Fixes
+ * Fix precedence error with (return ... and ...)
+ (nthykier) [github #385]
+
+0.98_05 Tue Apr 23 17:33:51 PDT 2013
+ Doc Changes
+ * Add a shorter work around for the UTF-8 output problem.
+ (Michael G Schwern)
+
+ Bug Fixes
+ * Test::Builder::Tester now works with subtests.
+ (Michael G Schwern) [github 350]
+ * Fix test_fail() inside a do statement.
+ (nnutter) [github #369]
+
+ New Features
+ * A subtest will put its name at the front of its results to make
+ subtests easier to read. [github #290] [github #364]
+ (Brendan Byrd)
+
+ Feature Changes
+ * like() and unlike() no longer warn about undef. [github #335]
+ (Michael G Schwern)
+
+
+0.98_04 Sun Apr 14 10:54:13 BST 2013
+ Distribution Changes
+ * Scalar::Util 1.13 (ships with Perl 5.8.1) is now required.
+ (Michael G Schwern)
+
+ Feature Changes
+ * The default name and diagnostics for isa_ok() and new_ok() have
+ changed. (Michael G Schwern)
+
+ Docs Fixes
+ * Added a COMPATIBILITY section so users know what major features were
+ added with what version of Test::More or perl. [github 343] [github 344]
+ (pdl)
+ * Fix the ok() example with grep(). (derek.mead@gmail.com)
+
+ Bug Fixes
+ * A test with no plan and missing done_testing() now exits with non-zero.
+ [github #341] (tokuhirom)
+ * isa_ok() tests were broken in 5.17 because of a change in
+ method resolution. [github #353] (Michael G Schwern)
+
+
+0.98_03 Thu Jun 21 13:04:19 PDT 2012
+ New Features
+ * cmp_ok() will error when used with something which is not a
+ comparison operator, including =, += and the like.
+ [github 141] (Matthew Horsfall)
+
+ Bug Fixes
+ * use_ok() was calling class->import without quoting which could
+ cause problems if "class" is also a function.
+
+ Doc Fixes
+ * use_ok() has been discouraged and de-emphasized as a general
+ replacement for `use` in tests. [github #288]
+ * $thing is now $this in the docs to avoid confusing users of
+ other languages. [Karen Etheridge]
+
+ Incompatible Changes With Previous Alphas (0.98_01)
+ * use_ok() will no longer apply lexical pragams. The incompatibilities
+ and extra complexity is not worth the marginal use.
+ [github #287]
+
+
+0.98_02 Thu Nov 24 01:13:53 PST 2011
+ Bug Fixes
+ * use_ok() in 0.98_01 was leaking pragmas from inside Test::More.
+ This looked like Test::More was forcing strict. [rt.cpan.org 67538]
+ (Father Chrysostomos)
+
+
+0.98_01 Tue Nov 8 17:07:58 PST 2011
+ Bug Fixes
+ * BAIL_OUT works inside a subtest. (Larry Leszczynski) [github #138]
+ * subtests now work with threads turned on. [github #145]
+
+ Feature Changes
+ * use_ok() will now apply lexical effects. [rt.cpan.org 67538]
+ (Father Chrysostomos)
+
+ Misc
+ * Test::More, Test::Simple and Test::Builder::Module now require
+ a minimum version of Test::Builder. This avoids Test::More and
+ Test::Builder from getting out of sync. [github #89]
+
+
0.98 Wed, 23 Feb 2011 14:38:02 +1100
Bug Fixes
* subtest() should not fail if $? is non-zero. (Aaron Crane)
use strict;
use warnings;
-our $VERSION = '0.98_06';
+our $VERSION = '0.99';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
BEGIN {
return $self;
}
+
+# Copy an object, currently a shallow.
+# This does *not* bless the destination. This keeps the destructor from
+# firing when we're just storing a copy of the object to restore later.
+sub _copy {
+ my($src, $dest) = @_;
+
+ %$dest = %$src;
+ _share_keys($dest);
+
+ return;
+}
+
+
=item B<child>
my $child = $builder->child($name_of_child);
# Clear $TODO for the child.
my $orig_TODO = $self->find_TODO(undef, 1, undef);
- my $child = bless {}, ref $self;
- $child->reset;
+ my $class = ref $self;
+ my $child = $class->create;
# Add to our indentation
$child->_indent( $self->_indent . ' ' );
-
- $child->{$_} = $self->{$_} foreach qw{Out_FH Todo_FH Fail_FH};
- if ($parent_in_todo) {
- $child->{Fail_FH} = $self->{Todo_FH};
+
+ # Make the child use the same outputs as the parent
+ for my $method (qw(output failure_output todo_output)) {
+ $child->$method( $self->$method );
+ }
+
+ # Ensure the child understands if they're inside a TODO
+ if( $parent_in_todo ) {
+ $child->failure_output( $self->todo_output );
}
# This will be reset in finalize. We do this here lest one child failure
# Turn the child into the parent so anyone who has stored a copy of
# the Test::Builder singleton will get the child.
- my($error, $child, %parent);
+ my $error;
+ my $child;
+ my $parent = {};
{
# child() calls reset() which sets $Level to 1, so we localize
# $Level first to limit the scope of the reset to the subtest.
local $Test::Builder::Level = $Test::Builder::Level + 1;
+ # Store the guts of $self as $parent and turn $child into $self.
$child = $self->child($name);
- %parent = %$self;
- %$self = %$child;
+ _copy($self, $parent);
+ _copy($child, $self);
my $run_the_subtests = sub {
+ # Add subtest name for clarification of starting point
+ $self->note("Subtest: $name");
$subtests->();
$self->done_testing unless $self->_plan_handled;
1;
}
# Restore the parent and the copied child.
- %$child = %$self;
- %$self = %parent;
+ _copy($self, $child);
+ _copy($parent, $self);
# Restore the parent's $TODO
$self->find_TODO(undef, 1, $child->{Parent_TODO});
die $error if $error and !eval { $error->isa('Test::Builder::Exception') };
local $Test::Builder::Level = $Test::Builder::Level + 1;
- return $child->finalize;
+ my $finalize = $child->finalize;
+
+ $self->BAIL_OUT($child->{Bailed_Out_Reason}) if $child->{Bailed_Out};
+
+ return $finalize;
}
=begin _private
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ok = 1;
$self->parent->{Child_Name} = undef;
- if ( $self->{Skip_All} ) {
- $self->parent->skip($self->{Skip_All});
- }
- elsif ( not @{ $self->{Test_Results} } ) {
- $self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name );
- }
- else {
- $self->parent->ok( $self->is_passing, $self->name );
+ unless ($self->{Bailed_Out}) {
+ if ( $self->{Skip_All} ) {
+ $self->parent->skip($self->{Skip_All});
+ }
+ elsif ( not @{ $self->{Test_Results} } ) {
+ $self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name );
+ }
+ else {
+ $self->parent->ok( $self->is_passing, $self->name );
+ }
}
$? = $self->{Child_Error};
delete $self->{Parent};
$self->{Child_Name} = undef;
$self->{Indent} ||= '';
- share( $self->{Curr_Test} );
$self->{Curr_Test} = 0;
$self->{Test_Results} = &share( [] );
$self->{Start_Todo} = 0;
$self->{Opened_Testhandles} = 0;
+ $self->_share_keys;
$self->_dup_stdhandles;
return;
}
+
+# Shared scalar values are lost when a hash is copied, so we have
+# a separate method to restore them.
+# Shared references are retained across copies.
+sub _share_keys {
+ my $self = shift;
+
+ share( $self->{Curr_Test} );
+
+ return;
+}
+
+
=back
=head2 Setting up tests
for my $test (@tests) {
$Test->ok($test);
}
- $Test->done_testing(@tests);
+ $Test->done_testing(scalar @tests);
=cut
=item B<like>
- $Test->like($this, qr/$regex/, $name);
- $Test->like($this, '/$regex/', $name);
+ $Test->like($thing, qr/$regex/, $name);
+ $Test->like($thing, '/$regex/', $name);
-Like Test::More's C<like()>. Checks if $this matches the given C<$regex>.
+Like Test::More's C<like()>. Checks if $thing matches the given C<$regex>.
=item B<unlike>
- $Test->unlike($this, qr/$regex/, $name);
- $Test->unlike($this, '/$regex/', $name);
+ $Test->unlike($thing, qr/$regex/, $name);
+ $Test->unlike($thing, '/$regex/', $name);
-Like Test::More's C<unlike()>. Checks if $this B<does not match> the
+Like Test::More's C<unlike()>. Checks if $thing B<does not match> the
given C<$regex>.
=cut
sub like {
- my( $self, $this, $regex, $name ) = @_;
+ my( $self, $thing, $regex, $name ) = @_;
local $Level = $Level + 1;
- return $self->_regex_ok( $this, $regex, '=~', $name );
+ return $self->_regex_ok( $thing, $regex, '=~', $name );
}
sub unlike {
- my( $self, $this, $regex, $name ) = @_;
+ my( $self, $thing, $regex, $name ) = @_;
local $Level = $Level + 1;
- return $self->_regex_ok( $this, $regex, '!~', $name );
+ return $self->_regex_ok( $thing, $regex, '!~', $name );
}
=item B<cmp_ok>
- $Test->cmp_ok($this, $type, $that, $name);
+ $Test->cmp_ok($thing, $type, $that, $name);
Works just like Test::More's C<cmp_ok()>.
my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
+# Bad, these are not comparison operators. Should we include more?
+my %cmp_ok_bl = map { ( $_, 1 ) } ( "=", "+=", ".=", "x=", "^=", "|=", "||=", "&&=", "...");
+
sub cmp_ok {
my( $self, $got, $type, $expect, $name ) = @_;
+ if ($cmp_ok_bl{$type}) {
+ $self->croak("$type is not a valid comparison operator in cmp_ok()");
+ }
+
my $test;
my $error;
{
my( $self, $reason ) = @_;
$self->{Bailed_Out} = 1;
+
+ if ($self->parent) {
+ $self->{Bailed_Out_Reason} = $reason;
+ $self->no_ending(1);
+ die bless {} => 'Test::Builder::Exception';
+ }
+
$self->_print("Bail out! $reason");
exit 255;
}
could be written as:
sub laconic_like {
- my ($self, $this, $regex, $name) = @_;
+ my ($self, $thing, $regex, $name) = @_;
my $usable_regex = $self->maybe_regex($regex);
die "expecting regex, found '$regex'\n"
unless $usable_regex;
- $self->ok($this =~ m/$usable_regex/, $name);
+ $self->ok($thing =~ m/$usable_regex/, $name);
}
=cut
}
sub _regex_ok {
- my( $self, $this, $regex, $cmp, $name ) = @_;
+ my( $self, $thing, $regex, $cmp, $name ) = @_;
my $ok = 0;
my $usable_regex = $self->maybe_regex($regex);
}
{
- ## no critic (BuiltinFunctions::ProhibitStringyEval)
-
my $test;
my $context = $self->_caller_context;
- local( $@, $!, $SIG{__DIE__} ); # isolate eval
+ {
+ ## no critic (BuiltinFunctions::ProhibitStringyEval)
+
+ local( $@, $!, $SIG{__DIE__} ); # isolate eval
+
+ # No point in issuing an uninit warning, they'll see it in the diagnostics
+ no warnings 'uninitialized';
- $test = eval $context . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
+ $test = eval $context . q{$test = $thing =~ /$usable_regex/ ? 1 : 0};
+ }
$test = !$test if $cmp eq '!~';
}
unless($ok) {
- $this = defined $this ? "'$this'" : 'undef';
+ $thing = defined $thing ? "'$thing'" : 'undef';
my $match = $cmp eq '=~' ? "doesn't match" : "matches";
local $Level = $Level + 1;
- $self->diag( sprintf <<'DIAGNOSTIC', $this, $match, $regex );
+ $self->diag( sprintf <<'DIAGNOSTIC', $thing, $match, $regex );
%s
%13s '%s'
DIAGNOSTIC
if( !$self->{Have_Plan} and $self->{Curr_Test} ) {
$self->is_passing(0);
$self->diag("Tests were run but no plan was declared and done_testing() was not seen.");
+
+ if($real_exit_code) {
+ $self->diag(<<"FAIL");
+Looks like your test exited with $real_exit_code just after $self->{Curr_Test}.
+FAIL
+ $self->is_passing(0);
+ _my_exit($real_exit_code) && return;
+ }
+
+ # But if the tests ran, handle exit code.
+ my $test_results = $self->{Test_Results};
+ if(@$test_results) {
+ my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ];
+ if ($num_failed > 0) {
+
+ my $exit_code = $num_failed <= 254 ? $num_failed : 254;
+ _my_exit($exit_code) && return;
+ }
+ }
+ _my_exit(254) && return;
}
# Exit if plan() was never called. This is so "require Test::Simple"
use strict;
-use Test::Builder;
+use Test::Builder 0.99;
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '0.98_06';
+our $VERSION = '0.99';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
package Test::Builder::Tester;
use strict;
-our $VERSION = "1.22";
+our $VERSION = "1.23_002";
-use Test::Builder;
+use Test::Builder 0.98;
use Symbol;
use Carp;
# for remembering that we're testing and where we're testing at
my $testing = 0;
my $testing_num;
+my $original_is_passing;
# remembering where the file handles were originally connected
my $original_output_handle;
my $original_failure_handle;
my $original_todo_handle;
-my $original_test_number;
-my $original_harness_state;
-
my $original_harness_env;
# function that starts testing and redirects the filehandles for now
$testing = 1;
$testing_num = $t->current_test;
$t->current_test(0);
+ $original_is_passing = $t->is_passing;
+ $t->is_passing(1);
# look, we shouldn't do the ending stuff
$t->no_ending(1);
$line = $line + ( shift() || 0 ); # prevent warnings
# expect that on stderr
- $err->expect("# Failed test ($0 at line $line)");
+ $err->expect("# Failed test ($filename at line $line)");
}
=item test_diag
Actually performs the output check testing the tests, comparing the
data (with C<eq>) that we have captured from B<Test::Builder> against
-that that was declared with C<test_out> and C<test_err>.
+what was declared with C<test_out> and C<test_err>.
This takes name/value pairs that effect how the test is run.
# restore the test no, etc, back to the original point
$t->current_test($testing_num);
$testing = 0;
+ $t->is_passing($original_is_passing);
# re-enable the original setting of the harness
$ENV{HARNESS_ACTIVE} = $original_harness_env;
Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
-Some code taken from B<Test::More> and B<Test::Catch>, written by by
+Some code taken from B<Test::More> and B<Test::Catch>, written by
Michael G Schwern E<lt>schwern@pobox.comE<gt>. Hence, those parts
Copyright Micheal G Schwern 2001. Used and distributed with
permission.
my @checks = @_;
foreach my $check (@checks) {
+ $check = $self->_account_for_subtest($check);
$check = $self->_translate_Failed_check($check);
push @{ $self->{wanted} }, ref $check ? $check : "$check\n";
}
}
+sub _account_for_subtest {
+ my( $self, $check ) = @_;
+
+ # Since we ship with Test::Builder, calling a private method is safe...ish.
+ return $t->_indent . $check;
+}
+
sub _translate_Failed_check {
my( $self, $check ) = @_;
my $self = shift;
my $type = $self->type;
my $got = $self->got;
- my $wanted = join "\n", @{ $self->wanted };
+ my $wanted = join '', @{ $self->wanted };
# are we running in colour mode?
if(Test::Builder::Tester::color) {
package Test::Builder::Tester::Color;
use strict;
-our $VERSION = "1.22";
+our $VERSION = "1.23_002";
require Test::Builder::Tester;
return warn @_, " at $file line $line\n";
}
-our $VERSION = '0.98_06';
+our $VERSION = '0.99';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-use Test::Builder::Module;
+use Test::Builder::Module 0.99;
our @ISA = qw(Test::Builder::Module);
our @EXPORT = qw(ok use_ok require_ok
is isnt like unlike is_deeply
# or
use Test::More; # see done_testing()
- BEGIN { use_ok( 'Some::Module' ); }
require_ok( 'Some::Module' );
# Various ways to say "ok"
ok( $exp{9} == 81, 'simple exponential' );
ok( Film->can('db_Main'), 'set_db()' );
ok( $p->tests == 4, 'saw tests' );
- ok( !grep !defined $_, @items, 'items populated' );
+ ok( !grep(!defined $_, @items), 'all items defined' );
(Mnemonic: "This is ok.")
ok( $foo ne '', "Got some foo" );
C<undef> will only ever match C<undef>. So you can test a value
-agains C<undef> like this:
+against C<undef> like this:
is($not_defined, undef, "undefined as expected");
is similar to:
- ok( $got =~ /expected/, 'this is like that');
+ ok( $got =~ m/expected/, 'this is like that');
(Mnemonic "This is like that".)
cmp_ok( $got, $op, $expected, $test_name );
-Halfway between ok() and is() lies cmp_ok(). This allows you to
-compare two arguments using any binary perl operator.
+Halfway between C<ok()> and C<is()> lies C<cmp_ok()>. This allows you
+to compare two arguments using any binary perl operator. The test
+passes if the comparison is true and fails otherwise.
# ok( $got eq $expected );
cmp_ok( $got, 'eq', $expected, 'this eq that' );
=cut
sub isa_ok ($$;$) {
- my( $object, $class, $obj_name ) = @_;
+ my( $thing, $class, $thing_name ) = @_;
my $tb = Test::More->builder;
- my $diag;
+ my $whatami;
+ if( !defined $thing ) {
+ $whatami = 'undef';
+ }
+ elsif( ref $thing ) {
+ $whatami = 'reference';
- if( !defined $object ) {
- $obj_name = 'The thing' unless defined $obj_name;
- $diag = "$obj_name isn't defined";
+ local($@,$!);
+ require Scalar::Util;
+ if( Scalar::Util::blessed($thing) ) {
+ $whatami = 'object';
+ }
}
else {
- my $whatami = ref $object ? 'object' : 'class';
- # We can't use UNIVERSAL::isa because we want to honor isa() overrides
- my( $rslt, $error ) = $tb->_try( sub { $object->isa($class) } );
- if($error) {
- if( $error =~ /^Can't call method "isa" on unblessed reference/ ) {
- # Its an unblessed reference
- $obj_name = 'The reference' unless defined $obj_name;
- if( !UNIVERSAL::isa( $object, $class ) ) {
- my $ref = ref $object;
- $diag = "$obj_name isn't a '$class' it's a '$ref'";
- }
- }
- elsif( $error =~ /Can't call method "isa" without a package/ ) {
- # It's something that can't even be a class
- $obj_name = 'The thing' unless defined $obj_name;
- $diag = "$obj_name isn't a class or reference";
- }
- else {
- die <<WHOA;
+ $whatami = 'class';
+ }
+
+ # We can't use UNIVERSAL::isa because we want to honor isa() overrides
+ my( $rslt, $error ) = $tb->_try( sub { $thing->isa($class) } );
+
+ if($error) {
+ die <<WHOA unless $error =~ /^Can't (locate|call) method "isa"/;
WHOA! I tried to call ->isa on your $whatami and got some weird error.
Here's the error.
$error
WHOA
- }
- }
- else {
- $obj_name = "The $whatami" unless defined $obj_name;
- if( !$rslt ) {
- my $ref = ref $object;
- $diag = "$obj_name isn't a '$class' it's a '$ref'";
- }
- }
}
- my $name = "$obj_name isa $class";
- my $ok;
- if($diag) {
- $ok = $tb->ok( 0, $name );
- $tb->diag(" $diag\n");
+ # Special case for isa_ok( [], "ARRAY" ) and like
+ if( $whatami eq 'reference' ) {
+ $rslt = UNIVERSAL::isa($thing, $class);
+ }
+
+ my($diag, $name);
+ if( defined $thing_name ) {
+ $name = "'$thing_name' isa '$class'";
+ $diag = defined $thing ? "'$thing_name' isn't a '$class'" : "'$thing_name' isn't defined";
+ }
+ elsif( $whatami eq 'object' ) {
+ my $my_class = ref $thing;
+ $thing_name = qq[An object of class '$my_class'];
+ $name = "$thing_name isa '$class'";
+ $diag = "The object of class '$my_class' isn't a '$class'";
+ }
+ elsif( $whatami eq 'reference' ) {
+ my $type = ref $thing;
+ $thing_name = qq[A reference of type '$type'];
+ $name = "$thing_name isa '$class'";
+ $diag = "The reference of type '$type' isn't a '$class'";
+ }
+ elsif( $whatami eq 'undef' ) {
+ $thing_name = 'undef';
+ $name = "$thing_name isa '$class'";
+ $diag = "$thing_name isn't defined";
+ }
+ elsif( $whatami eq 'class' ) {
+ $thing_name = qq[The class (or class-like) '$thing'];
+ $name = "$thing_name isa '$class'";
+ $diag = "$thing_name isn't a '$class'";
}
else {
+ die;
+ }
+
+ my $ok;
+ if($rslt) {
$ok = $tb->ok( 1, $name );
}
+ else {
+ $ok = $tb->ok( 0, $name );
+ $tb->diag(" $diag\n");
+ }
return $ok;
}
my( $class, $args, $object_name ) = @_;
$args ||= [];
- $object_name = "The object" unless defined $object_name;
my $obj;
my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } );
isa_ok $obj, $class, $object_name;
}
else {
- $tb->ok( 0, "new() died" );
+ $class = 'undef' if !defined $class;
+ $tb->ok( 0, "$class->new() died" );
$tb->diag(" Error was: $error");
}
1..3
ok 1 - First test
+ # Subtest: An example subtest
1..2
ok 1 - This is a subtest
ok 2 - So is this
=head2 Module tests
-You usually want to test if the module you're testing loads ok, rather
-than just vomiting if its load fails. For such purposes we have
-C<use_ok> and C<require_ok>.
+Sometimes you want to test if a module, or a list of modules, can
+successfully load. For example, you'll often want a first test which
+simply loads all the modules in the distribution to make sure they
+work before going on to do more complicated testing.
+
+For such purposes we have C<use_ok> and C<require_ok>.
=over 4
+=item B<require_ok>
+
+ require_ok($module);
+ require_ok($file);
+
+Tries to C<require> the given $module or $file. If it loads
+successfully, the test will pass. Otherwise it fails and displays the
+load error.
+
+C<require_ok> will guess whether the input is a module name or a
+filename.
+
+No exception will be thrown if the load fails.
+
+ # require Some::Module
+ require_ok "Some::Module";
+
+ # require "Some/File.pl";
+ require_ok "Some/File.pl";
+
+ # stop testing if any of your modules will not load
+ for my $module (@module) {
+ require_ok $module or BAIL_OUT "Can't load $module";
+ }
+
+=cut
+
+sub require_ok ($) {
+ my($module) = shift;
+ my $tb = Test::More->builder;
+
+ my $pack = caller;
+
+ # Try to determine if we've been given a module name or file.
+ # Module names must be barewords, files not.
+ $module = qq['$module'] unless _is_module_name($module);
+
+ my $code = <<REQUIRE;
+package $pack;
+require $module;
+1;
+REQUIRE
+
+ my( $eval_result, $eval_error ) = _eval($code);
+ my $ok = $tb->ok( $eval_result, "require $module;" );
+
+ unless($ok) {
+ chomp $eval_error;
+ $tb->diag(<<DIAGNOSTIC);
+ Tried to require '$module'.
+ Error: $eval_error
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+sub _is_module_name {
+ my $module = shift;
+
+ # Module names start with a letter.
+ # End with an alphanumeric.
+ # The rest is an alphanumeric or ::
+ $module =~ s/\b::\b//g;
+
+ return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
+}
+
+
=item B<use_ok>
BEGIN { use_ok($module); }
BEGIN { use_ok($module, @imports); }
-These simply use the given $module and test to make sure the load
-happened ok. It's recommended that you run use_ok() inside a BEGIN
-block so its functions are exported at compile-time and prototypes are
-properly honored.
+Like C<require_ok>, but it will C<use> the $module in question and
+only loads modules, not files.
+
+If you just want to test a module can be loaded, use C<require_ok>.
+
+If you just want to load a module in a test, we recommend simply using
+C<use> directly. It will cause the test to stop.
+
+It's recommended that you run use_ok() inside a BEGIN block so its
+functions are exported at compile-time and prototypes are properly
+honored.
If @imports are given, they are passed through to the use. So this:
BEGIN { require_ok "Foo" }
-
=cut
sub use_ok ($;@) {
my $tb = Test::More->builder;
my( $pack, $filename, $line ) = caller;
+ $filename =~ y/\n\r/_/; # so it doesn't run off the "#line $line $f" line
my $code;
if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
# for it to work with non-Exporter based modules.
$code = <<USE;
package $pack;
+
+#line $line $filename
use $module $imports[0];
1;
USE
else {
$code = <<USE;
package $pack;
+
+#line $line $filename
use $module \@{\$args[0]};
1;
USE
return( $eval_result, $eval_error );
}
-=item B<require_ok>
-
- require_ok($module);
- require_ok($file);
-
-Like use_ok(), except it requires the $module or $file.
-
-=cut
-
-sub require_ok ($) {
- my($module) = shift;
- my $tb = Test::More->builder;
-
- my $pack = caller;
-
- # Try to determine if we've been given a module name or file.
- # Module names must be barewords, files not.
- $module = qq['$module'] unless _is_module_name($module);
-
- my $code = <<REQUIRE;
-package $pack;
-require $module;
-1;
-REQUIRE
-
- my( $eval_result, $eval_error ) = _eval($code);
- my $ok = $tb->ok( $eval_result, "require $module;" );
-
- unless($ok) {
- chomp $eval_error;
- $tb->diag(<<DIAGNOSTIC);
- Tried to require '$module'.
- Error: $eval_error
-DIAGNOSTIC
-
- }
-
- return $ok;
-}
-
-sub _is_module_name {
- my $module = shift;
-
- # Module names start with a letter.
- # End with an alphanumeric.
- # The rest is an alphanumeric or ::
- $module =~ s/\b::\b//g;
-
- return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
-}
=back
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
+changing, but it is guaranteed that whatever you throw at it won't
interfere with the test.
=item B<note>
B<NOTE> This behavior may go away in future versions.
-=head1 CAVEATS and NOTES
+=head1 COMPATIBILITY
+
+Test::More works with Perls as old as 5.8.1.
+
+Thread support is not very reliable before 5.10.1, but that's
+because threads are not very reliable before 5.10.1.
+
+Although Test::More has been a core module in versions of Perl since 5.6.2, Test::More has evolved since then, and not all of the features you're used to will be present in the shipped version of Test::More. If you are writing a module, don't forget to indicate in your package metadata the minimum version of Test::More that you require. For instance, if you want to use C<done_testing()> but want your test script to run on Perl 5.10.0, you will need to explicitly require Test::More > 0.88.
+
+Key feature milestones include:
=over 4
-=item Backwards compatibility
+=item subtests
+
+Subtests were released in Test::More 0.94, which came with Perl 5.12.0. Subtests did not implicitly call C<done_testing()> until 0.96; the first Perl with that fix was Perl 5.14.0 with 0.98.
+
+=item C<done_testing()>
+
+This was released in Test::More 0.88 and first shipped with Perl in 5.10.1 as part of Test::More 0.92.
+
+=item C<cmp_ok()>
+
+Although C<cmp_ok()> was introduced in 0.40, 0.86 fixed an important bug to make it safe for overloaded objects; the fixed first shipped with Perl in 5.10.1 as part of Test::More 0.92.
+
+=item C<new_ok()> C<note()> and C<explain()>
+
+These were was released in Test::More 0.82, and first shipped with Perl in 5.10.1 as part of Test::More 0.92.
-Test::More works with Perls as old as 5.6.0.
+=back
+
+There is a full version history in the Changes file, and the Test::More versions included as core can be found using L<Module::CoreList>:
+
+ $ corelist -a Test::More
+
+
+=head1 CAVEATS and NOTES
+=over 4
=item utf8 / "Wide character in print"
including changing their output disciplines, will not be seem by
Test::More.
-The work around is to change the filehandles used by Test::Builder
-directly.
+One work around is to apply encodings to STDOUT and STDERR as early
+as possible and before Test::More (or any other Test module) loads.
+
+ use open ':std', ':encoding(utf8)';
+ use Test::More;
+
+A more direct work around is to change the filehandles used by
+Test::Builder.
my $builder = Test::More->builder;
- binmode $builder->output, ":utf8";
- binmode $builder->failure_output, ":utf8";
- binmode $builder->todo_output, ":utf8";
+ binmode $builder->output, ":encoding(utf8)";
+ binmode $builder->failure_output, ":encoding(utf8)";
+ binmode $builder->todo_output, ":encoding(utf8)";
=item Overloaded objects
use strict;
-our $VERSION = '0.98_06';
+our $VERSION = '0.99';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-use Test::Builder::Module;
+use Test::Builder::Module 0.99;
our @ISA = qw(Test::Builder::Module);
our @EXPORT = qw(ok);
=head1 DESCRIPTION
-I<AHHHHHHH!!!! NOT TESTING! Anything but testing!
-Beat me, whip me, send me to Detroit, but don't make
+I<AHHHHHHH!!!! NOT TESTING! Anything but testing!
+Beat me, whip me, send me to Detroit, but don't make
me write tests!>
I<*sob*>
Is this you? Is writing tests right up there with writing
documentation and having your fingernails pulled out? Did you open up
-a test and read
+a test and read
######## We start with some black magic
print 1 + 1 == 2 ? "ok 1\n" : "not ok 1\n";
-since 1 + 1 is 2, it prints:
+Because 1 + 1 is 2, it prints:
1..1
ok 1
What this says is: C<1..1> "I'm going to run one test." [1] C<ok 1>
"The first test passed". And that's about all magic there is to
testing. Your basic unit of testing is the I<ok>. For each thing you
-test, an C<ok> is printed. Simple. B<Test::Harness> interprets your test
+test, an C<ok> is printed. Simple. L<Test::Harness> interprets your test
results to determine if you succeeded or failed (more on that later).
Writing all these print statements rapidly gets tedious. Fortunately,
-there's B<Test::Simple>. It has one function, C<ok()>.
+there's L<Test::Simple>. It has one function, C<ok()>.
#!/usr/bin/perl -w
ok( 1 + 1 == 2 );
-and that does the same thing as the code above. C<ok()> is the backbone
+That does the same thing as the previous code. C<ok()> is the backbone
of Perl testing, and we'll be using it instead of roll-your-own from
here on. If C<ok()> gets a true value, the test passes. False, it
fails.
ok( 1 + 1 == 2 );
ok( 2 + 2 == 5 );
-from that comes
+From that comes:
1..2
ok 1
# Failed test (test.pl at line 5)
# Looks like you failed 1 tests of 2.
-C<1..2> "I'm going to run two tests." This number is used to ensure
-your test program ran all the way through and didn't die or skip some
-tests. C<ok 1> "The first test passed." C<not ok 2> "The second test
-failed". Test::Simple helpfully prints out some extra commentary about
-your tests.
+C<1..2> "I'm going to run two tests." This number is a I<plan>. It helps to
+ensure your test program ran all the way through and didn't die or skip some
+tests. C<ok 1> "The first test passed." C<not ok 2> "The second test failed".
+Test::Simple helpfully prints out some extra commentary about your tests.
It's not scary. Come, hold my hand. We're going to give an example
of testing a module. For our example, we'll be testing a date
-library, B<Date::ICal>. It's on CPAN, so download a copy and follow
+library, L<Date::ICal>. It's on CPAN, so download a copy and follow
along. [2]
=head2 Where to start?
-This is the hardest part of testing, where do you start? People often
-get overwhelmed at the apparent enormity of the task of testing a
-whole module. Best place to start is at the beginning. Date::ICal is
-an object-oriented module, and that means you start by making an
-object. So we test C<new()>.
+This is the hardest part of testing, where do you start? People often get
+overwhelmed at the apparent enormity of the task of testing a whole module.
+The best place to start is at the beginning. C<Date::ICal> is an
+object-oriented module, and that means you start by making an object. Test
+C<new()>.
#!/usr/bin/perl -w
+ # assume these two lines are in all subsequent examples
+ use strict;
+ use warnings;
+
use Test::Simple tests => 2;
use Date::ICal;
ok( defined $ical ); # check that we got something
ok( $ical->isa('Date::ICal') ); # and it's the right class
-run that and you should get:
+Run that and you should get:
1..2
ok 1
ok 2
-congratulations, you've written your first useful test.
+Congratulations! You've written your first useful test.
=head2 Names
-That output isn't terribly descriptive, is it? When you have two
-tests you can figure out which one is #2, but what if you have 102?
+That output isn't terribly descriptive, is it? When you have two tests you can
+figure out which one is #2, but what if you have 102 tests?
Each test can be given a little descriptive name as the second
argument to C<ok()>.
ok( defined $ical, 'new() returned something' );
ok( $ical->isa('Date::ICal'), " and it's the right class" );
-So now you'd see...
+Now you'll see:
1..2
ok 1 - new() returned something
=head2 Test the manual
-Simplest way to build up a decent testing suite is to just test what
-the manual says it does. [3] Let's pull something out of the
+The simplest way to build up a decent testing suite is to just test what
+the manual says it does. [3] Let's pull something out of the
L<Date::ICal/SYNOPSIS> and test that all its bits work.
#!/usr/bin/perl -w
use Date::ICal;
- $ical = Date::ICal->new( year => 1964, month => 10, day => 16,
- hour => 16, min => 12, sec => 47,
- tz => '0530' );
+ $ical = Date::ICal->new( year => 1964, month => 10, day => 16,
+ hour => 16, min => 12, sec => 47,
+ tz => '0530' );
ok( defined $ical, 'new() returned something' );
ok( $ical->isa('Date::ICal'), " and it's the right class" );
ok( $ical->sec == 47, ' sec()' );
- ok( $ical->min == 12, ' min()' );
+ ok( $ical->min == 12, ' min()' );
ok( $ical->hour == 16, ' hour()' );
ok( $ical->day == 17, ' day()' );
ok( $ical->month == 10, ' month()' );
ok( $ical->year == 1964, ' year()' );
-run that and you get:
+Run that and you get:
1..8
ok 1 - new() returned something
ok 8 - year()
# Looks like you failed 1 tests of 8.
-Whoops, a failure! [4] Test::Simple helpfully lets us know on what line
-the failure occurred, but not much else. We were supposed to get 17,
-but we didn't. What did we get?? Dunno. We'll have to re-run the
-test in the debugger or throw in some print statements to find out.
+Whoops, a failure! [4] C<Test::Simple> helpfully lets us know on what line the
+failure occurred, but not much else. We were supposed to get 17, but we
+didn't. What did we get?? Dunno. You could re-run the test in the debugger
+or throw in some print statements to find out.
-Instead, we'll switch from B<Test::Simple> to B<Test::More>. B<Test::More>
-does everything B<Test::Simple> does, and more! In fact, Test::More does
-things I<exactly> the way Test::Simple does. You can literally swap
-Test::Simple out and put Test::More in its place. That's just what
+Instead, switch from L<Test::Simple> to L<Test::More>. C<Test::More>
+does everything C<Test::Simple> does, and more! In fact, C<Test::More> does
+things I<exactly> the way C<Test::Simple> does. You can literally swap
+C<Test::Simple> out and put C<Test::More> in its place. That's just what
we're going to do.
-Test::More does more than Test::Simple. The most important difference
-at this point is it provides more informative ways to say "ok".
-Although you can write almost any test with a generic C<ok()>, it
-can't tell you what went wrong. Instead, we'll use the C<is()>
-function, which lets us declare that something is supposed to be the
-same as something else:
-
- #!/usr/bin/perl -w
+C<Test::More> does more than C<Test::Simple>. The most important difference at
+this point is it provides more informative ways to say "ok". Although you can
+write almost any test with a generic C<ok()>, it can't tell you what went
+wrong. The C<is()> function lets us declare that something is supposed to be
+the same as something else:
use Test::More tests => 8;
use Date::ICal;
- $ical = Date::ICal->new( year => 1964, month => 10, day => 16,
- hour => 16, min => 12, sec => 47,
- tz => '0530' );
+ $ical = Date::ICal->new( year => 1964, month => 10, day => 16,
+ hour => 16, min => 12, sec => 47,
+ tz => '0530' );
ok( defined $ical, 'new() returned something' );
ok( $ical->isa('Date::ICal'), " and it's the right class" );
is( $ical->sec, 47, ' sec()' );
- is( $ical->min, 12, ' min()' );
+ is( $ical->min, 12, ' min()' );
is( $ical->hour, 16, ' hour()' );
is( $ical->day, 17, ' day()' );
is( $ical->month, 10, ' month()' );
is( $ical->year, 1964, ' year()' );
"Is C<$ical-E<gt>sec> 47?" "Is C<$ical-E<gt>min> 12?" With C<is()> in place,
-you get some more information
+you get more information:
1..8
ok 1 - new() returned something
ok 8 - year()
# Looks like you failed 1 tests of 8.
-letting us know that C<$ical-E<gt>day> returned 16, but we expected 17. A
+Aha. C<$ical-E<gt>day> returned 16, but we expected 17. A
quick check shows that the code is working fine, we made a mistake
-when writing up the tests. Just change it to:
+when writing the tests. Change it to:
is( $ical->day, 16, ' day()' );
-and everything works.
+... and everything works.
-So any time you're doing a "this equals that" sort of test, use C<is()>.
+Any time you're doing a "this equals that" sort of test, use C<is()>.
It even works on arrays. The test is always in scalar context, so you
-can test how many elements are in a list this way. [5]
+can test how many elements are in an array this way. [5]
is( @foo, 5, 'foo has 5 elements' );
=head2 Sometimes the tests are wrong
-Which brings us to a very important lesson. Code has bugs. Tests are
+This brings up a very important lesson. Code has bugs. Tests are
code. Ergo, tests have bugs. A failing test could mean a bug in the
code, but don't discount the possibility that the test is wrong.
is( $ical->month, $expect->[1], ' month()' );
is( $ical->day, $expect->[2], ' day()' );
is( $ical->hour, $expect->[3], ' hour()' );
- is( $ical->min, $expect->[4], ' min()' );
+ is( $ical->min, $expect->[4], ' min()' );
is( $ical->sec, $expect->[5], ' sec()' );
}
-So now we can test bunches of dates by just adding them to
+Now we can test bunches of dates by just adding them to
C<%ICal_Dates>. Now that it's less work to test with more dates, you'll
be inclined to just throw more in as you think of them.
Only problem is, every time we add to that we have to keep adjusting
the C<use Test::More tests =E<gt> ##> line. That can rapidly get
-annoying. There's two ways to make this work better.
+annoying. There are ways to make this work better.
First, we can calculate the plan dynamically using the C<plan()>
function.
...and then your tests...
-Or to be even more flexible, we use C<no_plan>. This means we're just
+To be even more flexible, use C<done_testing>. This means we're just
running some tests, don't know how many. [6]
- use Test::More 'no_plan'; # instead of tests => 32
+ use Test::More; # instead of tests => 32
+
+ ... # tests here
+
+ done_testing(); # reached the end safely
-now we can just add tests and not have to do all sorts of math to
-figure out how many we're running.
+If you don't specify a plan, C<Test::More> expects to see C<done_testing()>
+before your program exits. It will warn you if you forget it. You can give
+C<done_testing()> an optional number of tests you expected to run, and if the
+number ran differs, C<Test::More> will give you another kind of warning.
=head2 Informative names
-Take a look at this line here
+Take a look at the line:
ok( defined $ical, "new(ical => '$ical_str')" );
-we've added more detail about what we're testing and the ICal string
+We've added more detail about what we're testing and the ICal string
itself we're trying out to the name. So you get results like:
ok 25 - new(ical => '19971024T120000')
ok 31 - min()
ok 32 - sec()
-if something in there fails, you'll know which one it was and that
-will make tracking down the problem easier. So try to put a bit of
+If something in there fails, you'll know which one it was and that
+will make tracking down the problem easier. Try to put a bit of
debugging information into the test names.
Describe what the tests test, to make debugging a failed test easier
is( $t2->epoch, 0, " and back to ICal" );
-The beginning of the epoch is different on most non-Unix operating
-systems [8]. Even though Perl smooths out the differences for the
-most part, certain ports do it differently. MacPerl is one off the
-top of my head. [9] So rather than just putting a comment in the test,
-we can explicitly say it's never going to work and skip the test.
+The beginning of the epoch is different on most non-Unix operating systems [8].
+Even though Perl smooths out the differences for the most part, certain ports
+do it differently. MacPerl is one off the top of my head. [9] Rather than
+putting a comment in the test and hoping someone will read the test while
+debugging the failure, we can explicitly say it's never going to work and skip
+the test.
use Test::More tests => 7;
use Date::ICal;
is( $t1->epoch, 0, "Epoch time of 0" );
SKIP: {
- skip('epoch to ICal not working on MacOS', 6)
+ skip('epoch to ICal not working on Mac OS', 6)
if $^O eq 'MacOS';
is( $t1->ical, '19700101Z', " epoch to ical" );
is( $t2->epoch, 0, " and back to ICal" );
}
-A little bit of magic happens here. When running on anything but
-MacOS, all the tests run normally. But when on MacOS, C<skip()> causes
-the entire contents of the SKIP block to be jumped over. It's never
-run. Instead, it prints special output that tells Test::Harness that
-the tests have been skipped.
+A little bit of magic happens here. When running on anything but MacOS, all
+the tests run normally. But when on MacOS, C<skip()> causes the entire
+contents of the SKIP block to be jumped over. It never runs. Instead,
+C<skip()> prints special output that tells C<Test::Harness> that the tests have
+been skipped.
1..7
ok 1 - Epoch time of 0
ok 6 # skip epoch to ICal not working on MacOS
ok 7 # skip epoch to ICal not working on MacOS
-This means your tests won't fail on MacOS. This means less emails
+This means your tests won't fail on MacOS. This means fewer emails
from MacPerl users telling you about failing tests that you know will
never work. You've got to be careful with skip tests. These are for
tests which don't work and I<never will>. It is not for skipping
=head2 Todo tests
-Thumbing through the Date::ICal man page, I came across this:
+While thumbing through the C<Date::ICal> man page, I came across this:
ical
Retrieves, or sets, the date on the object, using any
valid ICal date/time string.
-"Retrieves or sets". Hmmm, didn't see a test for using C<ical()> to set
-the date in the Date::ICal test suite. So I'll write one.
+"Retrieves or sets". Hmmm. I didn't see a test for using C<ical()> to set
+the date in the Date::ICal test suite. So I wrote one:
use Test::More tests => 1;
use Date::ICal;
$ical->ical('20201231Z');
is( $ical->ical, '20201231Z', 'Setting via ical()' );
-run that and I get
+Run that. I saw:
1..1
not ok 1 - Setting via ical()
# expected: '20201231Z'
# Looks like you failed 1 tests of 1.
-Whoops! Looks like it's unimplemented. Let's assume we don't have
-the time to fix this. [11] Normally, you'd just comment out the test
-and put a note in a todo list somewhere. Instead, we're going to
-explicitly state "this test will fail" by wrapping it in a C<TODO> block.
+Whoops! Looks like it's unimplemented. Assume you don't have the time to fix
+this. [11] Normally, you'd just comment out the test and put a note in a todo
+list somewhere. Instead, explicitly state "this test will fail" by wrapping it
+in a C<TODO> block:
use Test::More tests => 1;
# got: '20010822T201551Z'
# expected: '20201231Z'
-Test::More doesn't say "Looks like you failed 1 tests of 1". That '#
-TODO' tells Test::Harness "this is supposed to fail" and it treats a
-failure as a successful test. So you can write tests even before
+C<Test::More> doesn't say "Looks like you failed 1 tests of 1". That '#
+TODO' tells C<Test::Harness> "this is supposed to fail" and it treats a
+failure as a successful test. You can write tests even before
you've fixed the underlying code.
-If a TODO test passes, Test::Harness will report it "UNEXPECTEDLY
-SUCCEEDED". When that happens, you simply remove the TODO block with
-C<local $TODO> and turn it into a real test.
+If a TODO test passes, C<Test::Harness> will report it "UNEXPECTEDLY
+SUCCEEDED". When that happens, remove the TODO block with C<local $TODO> and
+turn it into a real test.
=head2 Testing with taint mode.
mode.
It's very simple to have your tests run under taint mode. Just throw
-a C<-T> into the C<#!> line. Test::Harness will read the switches
+a C<-T> into the C<#!> line. C<Test::Harness> will read the switches
in C<#!> and use them to run your tests.
#!/usr/bin/perl -Tw
...test normally here...
-So when you say C<make test> it will be run with taint mode and
-warnings on.
+When you say C<make test> it will run with taint mode on.
=head1 FOOTNOTES
=item 3
You can actually take this one step further and test the manual
-itself. Have a look at B<Test::Inline> (formerly B<Pod::Tests>).
+itself. Have a look at L<Test::Inline> (formerly L<Pod::Tests>).
=item 4
But what happens if your test program dies halfway through?! Since we
didn't say how many tests we're going to run, how can we know it
-failed? No problem, Test::More employs some magic to catch that death
+failed? No problem, C<Test::More> employs some magic to catch that death
and turn the test into a failure, even if every test passed up to that
point.
--- /dev/null
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::Builder::Tester tests => 1;
+use Test::More;
+
+subtest 'foo' => sub {
+ plan tests => 1;
+
+ test_out("not ok 1 - foo");
+ test_fail(+1);
+ fail("foo");
+ test_test("fail works");
+};
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::Builder::Tester tests => 3;
+use Test::More;
+use File::Basename qw(dirname);
+use File::Spec qw();
+
+my $file = File::Spec->join(dirname(__FILE__), 'tbt_09do_script.pl');
+my $done = do $file;
+ok(defined($done), 'do succeeded') or do {
+ if ($@) {
+ diag qq( \$@ is '$@'\n);
+ } elsif ($!) {
+ diag qq( \$! is '$!'\n);
+ } else {
+ diag qq( file's last statement returned undef: $file)
+ }
+};
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+isnt($0, __FILE__, 'code is not executing directly');
+
+test_out("not ok 1 - one");
+test_fail(+1);
+ok(0,"one");
+test_test('test_fail caught fail message inside a do');
+
+1;
#!/usr/bin/perl -w
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ('../lib', 'lib', '../lib/Test/Simple/t/lib');
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
use strict;
+use warnings;
+
+use lib 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
$TB->level(0);
sub try_cmp_ok {
- my($left, $cmp, $right) = @_;
+ my($left, $cmp, $right, $error) = @_;
my %expect;
- $expect{ok} = eval "\$left $cmp \$right";
- $expect{error} = $@;
- $expect{error} =~ s/ at .*\n?//;
+ if( $error ) {
+ $expect{ok} = 0;
+ $expect{error} = $error;
+ }
+ else {
+ $expect{ok} = eval "\$left $cmp \$right";
+ $expect{error} = $@;
+ $expect{error} =~ s/ at .*\n?//;
+ }
local $Test::Builder::Level = $Test::Builder::Level + 1;
- my $ok = cmp_ok($left, $cmp, $right, "cmp_ok");
+
+ my $ok;
+ eval { $ok = cmp_ok($left, $cmp, $right, "cmp_ok"); };
+
$TB->is_num(!!$ok, !!$expect{ok}, " right return");
my $diag = $err->read;
+
+ if ($@) {
+ $diag = $@;
+ $diag =~ s/ at .*\n?//;
+ }
+
if( !$ok and $expect{error} ) {
$diag =~ s/^# //mg;
$TB->like( $diag, qr/\Q$expect{error}\E/, " expected error" );
[$cmp, 'eq', "foo"],
[$ify, 'eq', "bar"],
[$ify, "==", 23],
+
+ [1, "=", 0, "= is not a valid comparison operator in cmp_ok()"],
+ [1, "+=", 0, "+= is not a valid comparison operator in cmp_ok()"],
);
plan tests => scalar @Tests;
# Modules which are known to be broken
my %Broken = map { $_ => 1 } qw(
- Test::Class
);
TODO: for my $name (@ARGV ? @ARGV : @Modules) {
'require.plx' => 0,
'death_with_handler.plx' => 255,
'exit.plx' => 1,
+ 'one_fail_without_plan.plx' => 1,
+ 'missing_done_testing.plx' => 254,
);
chdir 't';
#line 238
isa_ok(bless([], "Foo"), "Wibble");
out_ok( <<OUT, <<ERR );
-not ok - The object isa Wibble
+not ok - An object of class 'Foo' isa 'Wibble'
OUT
-# Failed test 'The object isa Wibble'
+# Failed test 'An object of class 'Foo' isa 'Wibble''
# at $0 line 238.
-# The object isn't a 'Wibble' it's a 'Foo'
+# The object of class 'Foo' isn't a 'Wibble'
ERR
#line 248
isa_ok(42, "Wibble", "My Wibble");
-out_like( <<OUT, <<ERR );
-not ok - My Wibble isa Wibble
+out_ok( <<OUT, <<ERR );
+not ok - 'My Wibble' isa 'Wibble'
OUT
-# Failed test 'My Wibble isa Wibble'
+# Failed test ''My Wibble' isa 'Wibble''
# at $0 line 248.
-# My Wibble isn't a .*
+# 'My Wibble' isn't a 'Wibble'
ERR
-#line 248
+#line 252
isa_ok(42, "Wibble");
-out_like( <<OUT, <<ERR );
-not ok - The (thing|class) isa Wibble
+out_ok( <<OUT, <<ERR );
+not ok - The class (or class-like) '42' isa 'Wibble'
OUT
-# Failed test 'The (thing|class) isa Wibble'
-# at $0 line 248.
-# The (thing|class) isn't a .*
+# Failed test 'The class (or class-like) '42' isa 'Wibble''
+# at $0 line 252.
+# The class (or class-like) '42' isn't a 'Wibble'
ERR
#line 258
isa_ok(undef, "Wibble", "Another Wibble");
out_ok( <<OUT, <<ERR );
-not ok - Another Wibble isa Wibble
+not ok - 'Another Wibble' isa 'Wibble'
OUT
-# Failed test 'Another Wibble isa Wibble'
+# Failed test ''Another Wibble' isa 'Wibble''
# at $0 line 258.
-# Another Wibble isn't defined
+# 'Another Wibble' isn't defined
ERR
#line 268
isa_ok([], "HASH");
out_ok( <<OUT, <<ERR );
-not ok - The reference isa HASH
+not ok - A reference of type 'ARRAY' isa 'HASH'
OUT
-# Failed test 'The reference isa HASH'
+# Failed test 'A reference of type 'ARRAY' isa 'HASH''
# at $0 line 268.
-# The reference isn't a 'HASH' it's a 'ARRAY'
+# The reference of type 'ARRAY' isn't a 'HASH'
ERR
#line 278
new_ok(undef);
out_like( <<OUT, <<ERR );
-not ok - new\\(\\) died
+not ok - undef->new\\(\\) died
OUT
-# Failed test 'new\\(\\) died'
+# Failed test 'undef->new\\(\\) died'
# at $Filename line 278.
# Error was: Can't call method "new" on an undefined value at .*
ERR
#line 288
new_ok( "Does::Not::Exist" );
out_like( <<OUT, <<ERR );
-not ok - new\\(\\) died
+not ok - Does::Not::Exist->new\\(\\) died
OUT
-# Failed test 'new\\(\\) died'
+# Failed test 'Does::Not::Exist->new\\(\\) died'
# at $Filename line 288.
# Error was: Can't locate object method "new" via package "Does::Not::Exist" .*
ERR
#line 303
new_ok( "Foo" );
out_ok( <<OUT, <<ERR );
-not ok - The object isa Foo
+not ok - undef isa 'Foo'
OUT
-# Failed test 'The object isa Foo'
+# Failed test 'undef isa 'Foo''
# at $0 line 303.
-# The object isn't defined
+# undef isn't defined
ERR
# line 313
new_ok( "Bar" );
out_ok( <<OUT, <<ERR );
-not ok - The object isa Bar
+not ok - A reference of type 'HASH' isa 'Bar'
OUT
-# Failed test 'The object isa Bar'
+# Failed test 'A reference of type 'HASH' isa 'Bar''
# at $0 line 313.
-# The object isn't a 'Bar' it's a 'HASH'
+# The reference of type 'HASH' isn't a 'Bar'
ERR
#line 323
new_ok( "Baz" );
out_ok( <<OUT, <<ERR );
-not ok - The object isa Baz
+not ok - An object of class 'Wibble' isa 'Baz'
OUT
-# Failed test 'The object isa Baz'
+# Failed test 'An object of class 'Wibble' isa 'Baz''
# at $0 line 323.
-# The object isn't a 'Baz' it's a 'Wibble'
+# The object of class 'Wibble' isn't a 'Baz'
ERR
#line 333
new_ok( "Baz", [], "no args" );
out_ok( <<OUT, <<ERR );
-not ok - no args isa Baz
+not ok - 'no args' isa 'Baz'
OUT
-# Failed test 'no args isa Baz'
+# Failed test ''no args' isa 'Baz''
# at $0 line 333.
-# no args isn't a 'Baz' it's a 'Wibble'
+# 'no args' isn't a 'Baz'
ERR
#line 343
}
sub is ($$;$) {
- my($this, $that, $name) = @_;
+ my($thing, $that, $name) = @_;
- my $ok = $TB->is_eq($$this, $that, $name);
+ my $ok = $TB->is_eq($$thing, $that, $name);
- $$this = '';
+ $$thing = '';
return $ok;
}
sub like ($$;$) {
- my($this, $regex, $name) = @_;
+ my($thing, $regex, $name) = @_;
$regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s;
- my $ok = $TB->like($$this, $regex, $name);
+ my $ok = $TB->like($$thing, $regex, $name);
- $$this = '';
+ $$thing = '';
return $ok;
}
is( $out, "not ok 40 - {x => 0} != {x => undef}\n" );
ok !is_deeply( {x => ''}, {x => undef}, "{x => ''} != {x => undef}" );
is( $out, "not ok 41 - {x => ''} != {x => undef}\n" );
-}
\ No newline at end of file
+}
use strict;
use warnings;
+use Symbol qw(gensym);
use base qw(Test::Builder);
);
$self->{_outputs} = \%outputs;
- tie *OUT, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{out};
- tie *ERR, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{err};
- tie *TODO, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{todo};
+ my($out, $err, $todo) = map { gensym() } 1..3;
+ tie *$out, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{out};
+ tie *$err, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{err};
+ tie *$todo, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{todo};
- $self->output(*OUT);
- $self->failure_output(*ERR);
- $self->todo_output(*TODO);
+ $self->output($out);
+ $self->failure_output($err);
+ $self->todo_output($todo);
return $self;
}
+
sub read {
my $self = shift;
my $stream = @_ ? shift : 'all';
--- /dev/null
+require Test::Simple;
+
+push @INC, 't/lib';
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+
+Test::Simple->import();
+ok(1);
--- /dev/null
+require Test::Simple;
+
+push @INC, 't/lib';
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+
+Test::Simple->import();
+ok(0);
--- /dev/null
+#!/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;
+
+my $output;
+my $TB = Test::More->builder;
+$TB->output(\$output);
+
+my $Test = Test::Builder->create;
+$Test->level(0);
+
+$Test->plan(tests => 2);
+
+plan tests => 4;
+
+ok 'foo';
+subtest 'bar' => sub {
+ plan tests => 3;
+ ok 'sub_foo';
+ subtest 'sub_bar' => sub {
+ plan tests => 3;
+ ok 'sub_sub_foo';
+ ok 'sub_sub_bar';
+ BAIL_OUT("ROCKS FALL! EVERYONE DIES!");
+ ok 'sub_sub_baz';
+ };
+ ok 'sub_baz';
+};
+
+$Test->is_eq( $output, <<'OUT' );
+1..4
+ok 1
+ # Subtest: bar
+ 1..3
+ ok 1
+ # Subtest: sub_bar
+ 1..3
+ ok 1
+ ok 2
+Bail out! ROCKS FALL! EVERYONE DIES!
+OUT
+
+$Test->is_eq( $Exit_Code, 255 );
$tb->ok( $_, "We're on $_" );
}
- $tb->reset_outputs;
is $tb->read, <<"END", 'Output should nest properly';
1..7
ok 1 - We're on 1
}
$tb->_ending;
- $tb->reset_outputs;
is $tb->read, <<"END", 'We should allow arbitrary nesting';
ok 1 - We're on 1
# We ran 1
$child->ok(3);
$child->finalize;
}
- $tb->reset_outputs;
is $tb->read, <<"END", 'Previous child failures should not force subsequent failures';
1..3
ok 1
$child->todo_end;
$child->finalize;
$tb->_ending;
- $tb->reset_outputs;
is $tb->read, <<"END", 'TODO tests should not make the parent test fail';
1..1
1..1
my $child = $tb->child;
$child->finalize;
$tb->_ending;
- $tb->reset_outputs;
my $expected = <<"END";
1..1
not ok 1 - No tests run for subtest "Child of $0"
our %line;
{
+ test_out(" # Subtest: namehere");
test_out(" 1..3");
test_out(" ok 1");
test_out(" not ok 2");
test_test("un-named inner tests");
}
{
+ test_out(" # Subtest: namehere");
test_out(" 1..3");
test_out(" ok 1 - first is good");
test_out(" not ok 2 - second is bad");
}; BEGIN{ $line{outerfail3} = __LINE__ }
}
{
+ test_out(" # Subtest: namehere");
test_out(" 1..3");
test_out(" ok 1 - first is good");
test_out(" not ok 2 - second is bad");
test_test("subtest() called from a sub");
}
{
+ test_out( " # Subtest: namehere");
test_out( " 1..0");
test_err( " # No tests run!");
test_out( 'not ok 1 - No tests run for subtest "namehere"');
test_test("lineno in 'No tests run' diagnostic");
}
{
+ test_out(" # Subtest: namehere");
test_out(" 1..1");
test_out(" not ok 1 - foo is bar");
test_err(" # Failed test 'foo is bar'");
use strict;
use warnings;
-use Test::More tests => 4;
+use Test::More tests => 5;
use Test::Builder;
use Test::Builder::Tester;
};
}
{
+ test_out(" # Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
foobar_ok($value, $name);
}
{
+ test_out(" # Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
});
}
{
+ test_out(" # Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
barfoo_ok($value, $name);
}
{
+ test_out(" # Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
# A subtest-based predicate called from within a subtest
{
+ test_out(" # Subtest: outergroup");
test_out(" 1..2");
test_out(" ok 1 - this passes");
+ test_out(" # Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_out(" not ok 2 - namehere");
test_err(" # Failed test 'namehere'");
test_err(" # at $0 line $line{ipredcall}.");
+ test_err(" # Looks like you failed 1 test of 2.");
test_out("not ok 1 - outergroup");
test_err("# Failed test 'outergroup'");
test_err("# at $0 line $line{outercall}.");
ok 1, "this passes";
barfoo_ok_2 "foot", "namehere"; BEGIN{ $line{ipredcall} = __LINE__ }
}; BEGIN{ $line{outercall} = __LINE__ }
-}
+ test_test("outergroup with internal barfoo_ok_2 failing line numbers");
+}
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Config;
+BEGIN {
+ unless ( $] >= 5.008001 && $Config{'useithreads'} &&
+ eval { require threads; 'threads'->import; 1; })
+ {
+ print "1..0 # Skip: no working threads\n";
+ exit 0;
+ }
+}
+
+use Test::More;
+
+subtest 'simple test with threads on' => sub {
+ is( 1+1, 2, "simple test" );
+ is( "a", "a", "another simple test" );
+};
+
+pass("Parent retains sharedness");
+
+done_testing(2);
my ($set_via, $todo_reason, $level) = @$combo;
test_out(
+ " # Subtest: xxx",
@outlines,
"not ok 1 - $xxx # TODO $todo_reason",
"# Failed (TODO) test '$xxx'",
#line 45
like( undef, qr/.*/, 'undef is like anything' );
-warnings_like(qr/Use of uninitialized value.* at $Filename line 45\.\n/);
+no_warnings;
eq_array( [undef, undef], [undef, 23] );
no_warnings;
#!/usr/bin/perl -w
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = qw(../lib ../lib/Test/Simple/t/lib);
- }
- else {
- unshift @INC, 't/lib';
- }
-}
+use strict;
+use warnings;
-use Test::More tests => 15;
+use lib 't/lib';
+use Test::More;
-# Using Symbol because it's core and exports lots of stuff.
-{
+note "Basic use_ok"; {
package Foo::one;
::use_ok("Symbol");
::ok( defined &gensym, 'use_ok() no args exports defaults' );
}
-{
+
+note "With one arg"; {
package Foo::two;
::use_ok("Symbol", qw(qualify));
::ok( !defined &gensym, ' one arg, defaults overridden' );
::ok( defined &qualify, ' right function exported' );
}
-{
+
+note "Multiple args"; {
package Foo::three;
::use_ok("Symbol", qw(gensym ungensym));
::ok( defined &gensym && defined &ungensym, ' multiple args' );
}
-{
+
+note "Defining constants"; {
package Foo::four;
my $warn; local $SIG{__WARN__} = sub { $warn .= shift; };
::use_ok("constant", qw(foo bar));
::is( $warn, undef, 'no warning');
}
-{
+
+note "use Module VERSION"; {
package Foo::five;
::use_ok("Symbol", 1.02);
}
-{
+
+note "use Module VERSION does not call import"; {
package Foo::six;
::use_ok("NoExporter", 1.02);
}
+
{
package Foo::seven;
local $SIG{__WARN__} = sub {
::use_ok("Test::More", 0.47);
}
-{
+
+note "Signals are preserved"; {
package Foo::eight;
local $SIG{__DIE__};
::use_ok("SigDie");
::ok(defined $SIG{__DIE__}, ' SIG{__DIE__} preserved');
}
+
+
+note "Line numbers preserved"; {
+ my $package = "that_cares_about_line_numbers";
+
+ # Store the output of caller.
+ my @caller;
+ {
+ package that_cares_about_line_numbers;
+
+ sub import {
+ @caller = caller;
+ return;
+ }
+
+ $INC{"$package.pm"} = 1; # fool use into thinking it's already loaded
+ }
+
+ ::use_ok($package);
+ my $line = __LINE__-1;
+ ::is( $caller[0], __PACKAGE__, "caller package preserved" );
+ ::is( $caller[1], __FILE__, " file" );
+ ::is( $caller[2], $line, " line" );
+}
+
+
+note "not confused by functions vs class names"; {
+ $INC{"ok.pm"} = 1;
+ use_ok("ok"); # ok is a function inside Test::More
+
+ $INC{"Foo/bar.pm"} = 1;
+ sub Foo::bar { 42 }
+ use_ok("Foo::bar"); # Confusing a class name with a function name
+}
+
+done_testing;
=item *
+L<Test::Simple> has been upgraded from version 0.98 to 0.99.
+
+Numerous updates and bug fixes are incorporated. See the F<Changes> file for
+full details.
+
+=item *
+
L<threads> has been upgraded from version 1.87 to 1.89.
The documentation of C<alarm> and C<_handle> has been updated.