cpan/Test-Harness/t/yamlish-writer.t Test::Harness test
cpan/Test/lib/Test.pm A simple framework for writing test scripts
cpan/Test-Simple/Changes Test::Simple changes
+cpan/Test-Simple/examples/indent.pl Test::Simple examples
+cpan/Test-Simple/examples/subtest.pl Test::Simple examples
cpan/Test-Simple/lib/Test/Builder/Module.pm Base class for test modules
cpan/Test-Simple/lib/Test/Builder.pm For writing new test libraries
cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm Turn on color in Test::Builder::Tester
cpan/Test-Simple/lib/Test/Simple.pm Basic utility for writing tests
cpan/Test-Simple/lib/Test/Tutorial.pod A tutorial on writing tests
cpan/Test-Simple/README Test::Simple README
+cpan/Test-Simple/t/00compile.t Test::Simple test
cpan/Test-Simple/t/00test_harness_check.t Test::Simple test
cpan/Test-Simple/t/bad_plan.t Test::Builder plan() test
cpan/Test-Simple/t/bail_out.t Test::Builder BAIL_OUT test
cpan/Test-Simple/t/Builder/has_plan2.t Test::Builder tests
cpan/Test-Simple/t/Builder/has_plan.t Test::Builder tests
cpan/Test-Simple/t/Builder/is_fh.t Test::Builder tests
+cpan/Test-Simple/t/Builder/is_passing.t Test::Builder tests
cpan/Test-Simple/t/Builder/maybe_regex.t Test::Builder tests
cpan/Test-Simple/t/Builder/no_diag.t Test::Builder tests
cpan/Test-Simple/t/Builder/no_ending.t Test::Builder tests
cpan/Test-Simple/t/c_flag.t Test::Simple test
cpan/Test-Simple/t/circular_data.t Test::Simple test
cpan/Test-Simple/t/cmp_ok.t Test::More test
+cpan/Test-Simple/t/dependents.t Test::More test
cpan/Test-Simple/t/diag.t Test::More diag() test
cpan/Test-Simple/t/died.t Test::Simple test
cpan/Test-Simple/t/dont_overwrite_die_handler.t Test::More tests
cpan/Test-Simple/t/simple.t Test::Simple test, basic stuff
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/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/exceptions.t Test::More test
+cpan/Test-Simple/t/subtest/for_do_t.t Test::More test
+cpan/Test-Simple/t/subtest/singleton.t Test::More test
cpan/Test-Simple/t/tbm_doesnt_set_exported_to.t Test::Builder::Module test
cpan/Test-Simple/t/Tester/tbt_01basic.t Test::Builder::Tester test
cpan/Test-Simple/t/Tester/tbt_02fhrestore.t Test::Builder::Tester test
'Test::Simple' =>
{
'MAINTAINER' => 'mschwern',
- 'DISTRIBUTION' => 'MSCHWERN/Test-Simple-0.92.tar.gz',
+ 'DISTRIBUTION' => 'MSCHWERN/Test-Simple-0.94.tar.gz',
'FILES' => q[cpan/Test-Simple],
'EXCLUDED' => [
qw{.perlcriticrc
t/pod.t
t/pod-coverage.t
t/Builder/reset_outputs.t
-
lib/Test/Builder/IO/Scalar.pm
}
],
'CPAN' => 1,
- 'UPSTREAM' => undef,
+ 'UPSTREAM' => 'cpan',
},
'Text::Balanced' =>
+0.94 Wed Sep 2 11:17:47 PDT 2009
+ Releasing 0.93_01 as stable.
+
+
+0.93_01 Mon Jul 20 09:51:08 PDT 2009
+ Bug Fixes
+ * Make sure that subtest works with Test:: modules which call
+ Test::Builder->new at the top of their code. (Ovid)
+
+ Other
+ * subtest() returns!
+
+
0.92 Fri Jul 3 11:08:56 PDT 2009
Test Fixes
* Silence noise on VMS in exit.t (Craig Berry)
* Skip Builder/fork_with_new_stdout.t on systems without fork (Craig Berry)
-
+
0.90 Thu Jul 2 13:18:25 PDT 2009
Docs
- * Finally added a note about the "Wide character in print" warning and
- how to work around it.
* Note the IO::Stringy license in our copy of it.
[test-more.googlecode.com 47]
+ Other
+ * This is a stable release for 5.10.1. It does not include
+ the subtest() work in 0.89_01.
+
+
+0.89_01 Tue Jun 23 15:13:16 EDT 2009
+ New Features
+ * subtest() allows you to run more tests in their own plan.
+ (Thanks Ovid!)
+ * Test::Builder->is_passing() will let you check if the test is
+ currently passing.
+
+ Docs
+ * Finally added a note about the "Wide character in print" warning and
+ how to work around it.
+
Test Fixes
* Small fixes for integration with the Perl core
[bleadperl eaa0815147e13cd4ab5b3d6ca8f26544a9f0c3b4]
* exit code tests could be effected by errno when PERLIO=stdio
[bleadperl c76230386fc5e6fba9fdbeab473abbf4f4adcbe3]
- Other
- * This is a stable release for 5.10.1. It does not include
- the subtest() work in 0.89_01.
-
0.88 Sat May 30 12:31:24 PDT 2009
Turing 0.87_03 into a stable release.
--- /dev/null
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use lib '../lib';
+use Test::Builder;
+
+=head1 NOTES
+
+Must have explicit finalize
+Must name nest
+Trailing summary test
+Pass chunk o'TAP
+No builder may have more than one child active
+What happens if you call ->finalize with open children
+
+=cut
+
+my $builder = Test::Builder->new;
+$builder->plan(tests => 7);
+for( 1 .. 3 ) {
+ $builder->ok( $_, "We're on $_" );
+ $builder->note("We ran $_");
+}
+{
+ my $indented = $builder->child;
+ $indented->plan('no_plan');
+ for( 1 .. 1+int(rand(5)) ) {
+ $indented->ok( 1, "We're on $_" );
+ }
+ $indented->finalize;
+}
+for( 7, 8, 9 ) {
+ $builder->ok( $_, "We're on $_" );
+}
--- /dev/null
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use lib '../lib';
+use Test::More tests => 3;
+
+ok 1;
+subtest 'some name' => sub {
+ my $num_tests = 2 + int( rand(3) );
+ plan tests => $num_tests;
+ ok 1 for 1 .. $num_tests - 1;
+ subtest 'some name' => sub {
+ plan 'no_plan';
+ ok 1 for 1 .. 2 + int( rand(3) );
+ };
+};
+ok 1;
use strict;
use warnings;
-our $VERSION = '0.92';
+our $VERSION = '0.94';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
BEGIN {
=cut
-my $Test = Test::Builder->new;
+our $Test = Test::Builder->new;
sub new {
my($class) = shift;
return $self;
}
+=item B<child>
+
+ my $child = $builder->child($name_of_child);
+ $child->plan( tests => 4 );
+ $child->ok(some_code());
+ ...
+ $child->finalize;
+
+Returns a new instance of C<Test::Builder>. Any output from this child will
+indented four spaces more than the parent's indentation. When done, the
+C<finalize> method I<must> be called explicitly.
+
+Trying to create a new child with a previous child still active (i.e.,
+C<finalize> not called) will C<croak>.
+
+Trying to run a test when you have an open child will also C<croak> and cause
+the test suite to fail.
+
+=cut
+
+sub child {
+ my( $self, $name ) = @_;
+
+ if( $self->{Child_Name} ) {
+ $self->croak("You already have a child named ($self->{Child_Name}) running");
+ }
+
+ my $child = bless {}, ref $self;
+ $child->reset;
+
+ # Add to our indentation
+ $child->_indent( $self->_indent . ' ' );
+ $child->{$_} = $self->{$_} foreach qw{Out_FH Todo_FH Fail_FH};
+
+ # This will be reset in finalize. We do this here lest one child failure
+ # cause all children to fail.
+ $child->{Child_Error} = $?;
+ $? = 0;
+ $child->{Parent} = $self;
+ $child->{Name} = $name || "Child of " . $self->name;
+ $self->{Child_Name} = $child->name;
+ return $child;
+}
+
+
+=item B<subtest>
+
+ $builder->subtest($name, \&subtests);
+
+See documentation of C<subtest> in Test::More.
+
+=cut
+
+sub subtest {
+ my $self = shift;
+ my($name, $subtests) = @_;
+
+ if ('CODE' ne ref $subtests) {
+ $self->croak("subtest()'s second argument must be a code ref");
+ }
+
+ # Turn the child into the parent so anyone who has stored a copy of
+ # the Test::Builder singleton will get the child.
+ my $child = $self->child($name);
+ my %parent = %$self;
+ %$self = %$child;
+
+ my $error;
+ if( !eval { $subtests->(); 1 } ) {
+ $error = $@;
+ }
+
+ # Restore the parent and the copied child.
+ %$child = %$self;
+ %$self = %parent;
+
+ # Die *after* we restore the parent.
+ die $error if $error and !eval { $error->isa('Test::Builder::Exception') };
+
+ return $child->finalize;
+}
+
+
+=item B<finalize>
+
+ my $ok = $child->finalize;
+
+When your child is done running tests, you must call C<finalize> to clean up
+and tell the parent your pass/fail status.
+
+Calling finalize on a child with open children will C<croak>.
+
+If the child falls out of scope before C<finalize> is called, a failure
+diagnostic will be issued and the child is considered to have failed.
+
+No attempt to call methods on a child after C<finalize> is called is
+guaranteed to succeed.
+
+Calling this on the root builder is a no-op.
+
+=cut
+
+sub finalize {
+ my $self = shift;
+
+ return unless $self->parent;
+ if( $self->{Child_Name} ) {
+ $self->croak("Can't call finalize() with child ($self->{Child_Name}) active");
+ }
+ $self->_ending;
+
+ # XXX This will only be necessary for TAP envelopes (we think)
+ #$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" );
+
+ 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 );
+ }
+ $? = $self->{Child_Error};
+ delete $self->{Parent};
+
+ return $self->is_passing;
+}
+
+sub _indent {
+ my $self = shift;
+
+ if( @_ ) {
+ $self->{Indent} = shift;
+ }
+
+ return $self->{Indent};
+}
+
+=item B<parent>
+
+ if ( my $parent = $builder->parent ) {
+ ...
+ }
+
+Returns the parent C<Test::Builder> instance, if any. Only used with child
+builders for nested TAP.
+
+=cut
+
+sub parent { shift->{Parent} }
+
+=item B<name>
+
+ diag $builder->name;
+
+Returns the name of the current builder. Top level builders default to C<$0>
+(the name of the executable). Child builders are named via the C<child>
+method. If no name is supplied, will be named "Child of $parent->name".
+
+=cut
+
+sub name { shift->{Name} }
+
+sub DESTROY {
+ my $self = shift;
+ if ( $self->parent ) {
+ my $name = $self->name;
+ $self->diag(<<"FAIL");
+Child ($name) exited without calling finalize()
+FAIL
+ $self->parent->{In_Destroy} = 1;
+ $self->parent->ok(0, $name);
+ }
+}
+
=item B<reset>
$Test->reset;
# hash keys is just asking for pain. Also, it was documented.
$Level = 1;
+ $self->{Name} = $0;
+ $self->is_passing(1);
+ $self->{Ending} = 0;
$self->{Have_Plan} = 0;
$self->{No_Plan} = 0;
$self->{Have_Output_Plan} = 0;
$self->{Original_Pid} = $$;
+ $self->{Child_Name} = undef;
+ $self->{Indent} ||= '';
share( $self->{Curr_Test} );
$self->{Curr_Test} = 0;
If you call C<plan()>, don't call any of the other methods below.
+If a child calls "skip_all" in the plan, a C<Test::Builder::Exception> is
+thrown. Trap this error, call C<finalize()> and don't run any more tests on
+the child.
+
+ my $child = $Test->child('some child');
+ eval { $child->plan( $condition ? ( skip_all => $reason ) : ( tests => 3 ) ) };
+ if ( eval { $@->isa('Test::Builder::Exception') } ) {
+ $child->finalize;
+ return;
+ }
+ # run your tests
+
=cut
my %plan_cmds = (
$self->{Have_Plan} = 1;
+ # The wrong number of tests were run
+ $self->is_passing(0) if $self->{Expected_Tests} != $self->{Curr_Test};
+
+ # No tests were run
+ $self->is_passing(0) if $self->{Curr_Test} == 0;
+
return 1;
}
sub skip_all {
my( $self, $reason ) = @_;
- $self->{Skip_All} = 1;
+ $self->{Skip_All} = $self->parent ? $reason : 1;
$self->_output_plan(0, "SKIP", $reason) unless $self->no_header;
+ if ( $self->parent ) {
+ die bless {} => 'Test::Builder::Exception';
+ }
exit(0);
}
sub ok {
my( $self, $test, $name ) = @_;
+ if ( $self->{Child_Name} and not $self->{In_Destroy} ) {
+ $name = 'unnamed test' unless defined $name;
+ $self->is_passing(0);
+ $self->croak("Cannot run test ($name) with active children");
+ }
# $test might contain an object which we don't want to accidentally
# store, so we turn it into a boolean.
$test = $test ? 1 : 0;
}
}
+ $self->is_passing(0) unless $test || $self->in_todo;
+
+ # Check that we haven't violated the plan
+ $self->_check_is_passing_plan();
+
return $test ? 1 : 0;
}
+
+# Check that we haven't yet violated the plan and set
+# is_passing() accordingly
+sub _check_is_passing_plan {
+ my $self = shift;
+
+ my $plan = $self->has_plan;
+ return unless defined $plan; # no plan yet defined
+ return unless $plan !~ /\D/; # no numeric plan
+ $self->is_passing(0) if $plan < $self->{Curr_Test};
+}
+
+
sub _unoverload {
my $self = shift;
my $type = shift;
Like Test::More's C<like()>. Checks if $this matches the given C<$regex>.
-You'll want to avoid C<qr//> if you want your tests to work before 5.005.
-
=item B<unlike>
$Test->unlike($this, qr/$regex/, $name);
=cut
-*BAILOUT = \&BAIL_OUT;
+{
+ no warnings 'once';
+ *BAILOUT = \&BAIL_OUT;
+}
=item B<skip>
$Test->maybe_regex(qr/$regex/);
$Test->maybe_regex('/$regex/');
+This method used to be useful back when Test::Builder worked on Perls
+before 5.6 which didn't have qr//. Now its pretty useless.
+
Convenience method for building testing functions that take regular
-expressions as arguments, but need to work before perl 5.005.
+expressions as arguments.
Takes a quoted regular expression produced by C<qr//>, or a string
representing a regular expression.
## no critic (BuiltinFunctions::ProhibitStringyEval)
my $test;
- my $code = $self->_caller_context;
+ my $context = $self->_caller_context;
local( $@, $!, $SIG{__DIE__} ); # isolate eval
- # 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" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
+ $test = eval $context . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
$test = !$test if $cmp eq '!~';
return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
return eval { $maybe_fh->isa("IO::Handle") } ||
- # 5.5.4's tied() and can() doesn't like getting undef
- eval { ( tied($maybe_fh) || '' )->can('TIEHANDLE') };
+ eval { tied($maybe_fh)->can('TIEHANDLE') };
}
=back
# Stick a newline on the end if it needs it.
$msg .= "\n" unless $msg =~ /\n\z/;
- return print $fh $msg;
+ return print $fh $self->_indent, $msg;
}
=item B<output>
return $self->{Curr_Test};
}
+=item B<is_passing>
+
+ my $ok = $builder->is_passing;
+
+Indicates if the test suite is currently passing.
+
+More formally, it will be false if anything has happened which makes
+it impossible for the test suite to pass. True otherwise.
+
+For example, if no tests have run C<is_passing()> will be true because
+even though a suite with no tests is a failure you can add a passing
+test to it and start passing.
+
+Don't think about it too much.
+
+=cut
+
+sub is_passing {
+ my $self = shift;
+
+ if( @_ ) {
+ $self->{Is_Passing} = shift;
+ }
+
+ return $self->{Is_Passing};
+}
+
+
=item B<summary>
my @tests = $Test->summary;
_my_exit($exit_num);
-Perl seems to have some trouble with exiting inside an C<END> block. 5.005_03
-and 5.6.1 both seem to do odd things. Instead, this function edits C<$?>
-directly. It should B<only> be called from inside an C<END> block. It
-doesn't actually exit, that's your job.
+Perl seems to have some trouble with exiting inside an C<END> block.
+5.6.1 does some odd things. Instead, this function edits C<$?>
+directly. It should B<only> be called from inside an C<END> block.
+It doesn't actually exit, that's your job.
=cut
sub _ending {
my $self = shift;
+ return if $self->no_ending;
+ return if $self->{Ending}++;
my $real_exit_code = $?;
# Ran tests but never declared a plan or hit done_testing
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.");
}
# Don't do an ending if we bailed out.
if( $self->{Bailed_Out} ) {
+ $self->is_passing(0);
return;
}
-
# Figure out if we passed or failed and print helpful messages.
my $test_results = $self->{Test_Results};
if(@$test_results) {
$self->diag(<<"FAIL");
Looks like you planned $self->{Expected_Tests} test$s but ran $self->{Curr_Test}.
FAIL
+ $self->is_passing(0);
}
if($num_failed) {
$self->diag(<<"FAIL");
Looks like you failed $num_failed test$s of $num_tests$qualifier.
FAIL
+ $self->is_passing(0);
}
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;
}
$self->diag(<<"FAIL");
Looks like your test exited with $real_exit_code before it could output anything.
FAIL
+ $self->is_passing(0);
_my_exit($real_exit_code) && return;
}
else {
$self->diag("No tests run!\n");
+ $self->is_passing(0);
_my_exit(255) && return;
}
+ $self->is_passing(0);
$self->_whoa( 1, "We fell off the end of _ending()" );
}
END {
- $Test->_ending if defined $Test and !$Test->no_ending;
+ $Test->_ending if defined $Test;
}
=head1 EXIT CODES
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '0.92';
+our $VERSION = '0.94';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
-# 5.004's Exporter doesn't have export_to_level.
-my $_export_to_level = sub {
- my $pkg = shift;
- my $level = shift;
- (undef) = shift; # redundant arg
- my $callpkg = caller($level);
- $pkg->export( $callpkg, @_ );
-};
=head1 NAME
$test->plan(@_);
- $class->$_export_to_level( 1, $class, @imports );
+ $class->export_to_level( 1, $class, @imports );
}
sub _strip_imports {
our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
-# _export_to_level and import stolen directly from Test::More. I am
-# the king of cargo cult programming ;-)
-
-# 5.004's Exporter doesn't have export_to_level.
-sub _export_to_level {
- my $pkg = shift;
- my $level = shift;
- (undef) = shift; # XXX redundant arg
- my $callpkg = caller($level);
- $pkg->export( $callpkg, @_ );
-}
-
sub import {
my $class = shift;
my(@plan) = @_;
}
}
- __PACKAGE__->_export_to_level( 1, __PACKAGE__, @imports );
+ __PACKAGE__->export_to_level( 1, __PACKAGE__, @imports );
}
###
extraneous whitespace at the end of lines that may cause your test to
fail even though the output looks similar.
-To assist you, if you have the B<Term::ANSIColor> module installed
-(which you should do by default from perl 5.005 onwards), C<test_test>
-can colour the background of the debug information to disambiguate the
-different types of output. The debug output will have it's background
-coloured green and red. The green part represents the text which is
-the same between the executed and actual output, the red shows which
-part differs.
+To assist you C<test_test> can colour the background of the debug
+information to disambiguate the different types of output. The debug
+output will have it's background coloured green and red. The green
+part represents the text which is the same between the executed and
+actual output, the red shows which part differs.
The C<color> function determines if colouring should occur or not.
Passing it a true or false value will enable or disable colouring
tests than we strictly should have and it'll register any failures we
had that we were testing for as real failures.
-The color function doesn't work unless B<Term::ANSIColor> is installed
-and is compatible with your terminal.
+The color function doesn't work unless B<Term::ANSIColor> is
+compatible with your terminal.
Bugs (and requests for new features) can be reported to the author
though the CPAN RT system:
=head1 NOTES
-This code has been tested explicitly on the following versions
-of perl: 5.7.3, 5.6.1, 5.6.0, 5.005_03, 5.004_05 and 5.004.
-
Thanks to Richard Clamp E<lt>richardc@unixbeard.netE<gt> for letting
me use his testing system to try this module out on.
return warn @_, " at $file line $line\n";
}
-our $VERSION = '0.92';
+our $VERSION = '0.94';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
done_testing
can_ok isa_ok new_ok
diag note explain
+ subtest
BAIL_OUT
);
All test functions take a name argument. It's optional, but highly
suggested that you use it.
-
=head2 I'm ok, you're not ok.
The basic purpose of this module is to print out either "ok #" or "not
}
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 {
return $obj;
}
+=item B<subtest>
+
+ subtest $name => \&code;
+
+subtest() runs the &code as its own little test with its own plan and
+its own result. The main test counts this as a single test using the
+result of the whole subtest to determine if its ok or not ok.
+
+For example...
+
+ use Test::More tests => 3;
+
+ pass("First test");
+
+ subtest 'An example subtest' => sub {
+ plan tests => 2;
+
+ pass("This is a subtest");
+ pass("So is this");
+ };
+
+ pass("Third test");
+
+This would produce.
+
+ 1..3
+ ok 1 - First test
+ 1..2
+ ok 1 - This is a subtest
+ ok 2 - So is this
+ ok 2 - An example subtest
+ ok 3 - Third test
+
+A subtest may call "skip_all". No tests will be run, but the subtest is
+considered a skip.
+
+ subtest 'skippy' => sub {
+ plan skip_all => 'cuz I said so';
+ pass('this test will never be run');
+ };
+
+Returns true if the subtest passed, false otherwise.
+
+=cut
+
+sub subtest($&) {
+ my ($name, $subtests) = @_;
+
+ my $tb = Test::More->builder;
+ return $tb->subtest(@_);
+}
+
=item B<pass>
=item B<fail>
Once a todo test starts succeeding, simply move it outside the block.
When the block is empty, delete it.
-B<NOTE>: TODO tests require a Test::Harness upgrade else it will
-treat it as a normal failure. See L<CAVEATS and NOTES>).
-
=item B<todo_skip>
5.8.1 and above are supported. Anything below that has too many bugs.
-
-=item Test::Harness upgrade
-
-no_plan, todo and done_testing() depend on new Test::Harness features
-and fixes. If you're going to distribute tests that use no_plan or
-todo your end-users will have to upgrade Test::Harness to the latest
-one on CPAN. If you avoid no_plan and TODO tests, the stock
-Test::Harness will work fine.
-
-Installing Test::More should also upgrade Test::Harness.
-
=back
package Test::Simple;
-use 5.004;
+use 5.006;
use strict;
-our $VERSION = '0.92';
+our $VERSION = '0.94';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
=head1 NOTES
-Test::Simple is B<explicitly> tested all the way back to perl 5.004.
+Test::Simple is B<explicitly> tested all the way back to perl 5.6.0.
-Test::Simple is thread-safe in perl 5.8.0 and up.
+Test::Simple is thread-safe in perl 5.8.1 and up.
=head1 HISTORY
use Date::ICal;
my %ICal_Dates = (
- # An ICal string And the year, month, date
+ # An ICal string And the year, month, day
# hour, minute and second we expect.
'19971024T120000' => # from the docs.
[ 1997, 10, 24, 12, 0, 0 ],
);
# For each key in the hash we're running 8 tests.
- plan tests => keys %ICal_Dates * 8;
+ plan tests => keys(%ICal_Dates) * 8;
+
+ ...and then your tests...
Or to be even more flexible, we use C<no_plan>. This means we're just
running some tests, don't know how many. [6]
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] We I<know> this will never work on MacOS. So rather than
-just putting a comment in the test, we can explicitly say it's never
-going to work and skip the test.
+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.
use Test::More tests => 7;
use Date::ICal;
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+chdir 't';
+
+use Test::More;
+
+my $Has_Test_Pod;
+BEGIN {
+ $Has_Test_Pod = eval 'use Test::Pod 0.95; 1';
+}
+
+chdir "..";
+my $manifest = "MANIFEST";
+open(my $manifest_fh, "<", $manifest) or die "Can't open $manifest: $!";
+my @modules = map { m{^lib/(\S+)}; $1 }
+ grep { m{^lib/Test/\S*\.pm} }
+ grep { !m{/t/} } <$manifest_fh>;
+
+chomp @modules;
+close $manifest_fh;
+
+chdir 'lib';
+plan tests => scalar @modules * 2;
+foreach my $file (@modules) {
+ # Make sure we look at the local files and do not reload them if
+ # they're already loaded. This avoids recompilation warnings.
+ local @INC = @INC;
+ unshift @INC, ".";
+ ok eval { require($file); 1 } or diag "require $file failed.\n$@";
+
+ SKIP: {
+ skip "Test::Pod not installed", 1 unless $Has_Test_Pod;
+ pod_file_ok($file);
+ }
+}
#!/usr/bin/perl -w
-#!perl -w
-
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib 't/lib';
+
+# We're going to need to override exit() later
+BEGIN {
+ *CORE::GLOBAL::exit = sub(;$) {
+ my $status = @_ ? 0 : shift;
+ CORE::exit $status;
+ };
+}
+
+use Test::More;
+use Test::Builder;
+use Test::Builder::NoOutput;
+
+{
+ my $tb = Test::Builder::NoOutput->create;
+ ok $tb->is_passing, "a fresh TB object is passing";
+
+ $tb->ok(1);
+ ok $tb->is_passing, " still passing after a test";
+
+ $tb->ok(0);
+ ok !$tb->is_passing, " not passing after a failing test";
+
+ $tb->ok(1);
+ ok !$tb->is_passing, " a passing test doesn't resurrect it";
+
+ $tb->done_testing(3);
+ ok !$tb->is_passing, " a successful plan doesn't help either";
+}
+
+
+# See if is_passing() notices a plan overrun
+{
+ my $tb = Test::Builder::NoOutput->create;
+ $tb->plan( tests => 1 );
+ $tb->ok(1);
+ ok $tb->is_passing, "Passing with a plan";
+
+ $tb->ok(1);
+ ok !$tb->is_passing, " passing test, but it overran the plan";
+}
+
+
+# is_passing() vs no_plan
+{
+ my $tb = Test::Builder::NoOutput->create;
+ $tb->plan( "no_plan" );
+ ok $tb->is_passing, "Passing with no_plan";
+
+ $tb->ok(1);
+ ok $tb->is_passing, " still passing after a test";
+
+ $tb->ok(1);
+ ok $tb->is_passing, " and another test";
+
+ $tb->_ending;
+ ok $tb->is_passing, " and after the ending";
+}
+
+
+# is_passing() vs skip_all
+{
+ my $tb = Test::Builder::NoOutput->create;
+
+ {
+ no warnings 'redefine';
+ local *CORE::GLOBAL::exit = sub {
+ return 1;
+ };
+ $tb->plan( "skip_all" );
+ }
+ ok $tb->is_passing, "Passing with skip_all";
+}
+
+
+# is_passing() vs done_testing(#)
+{
+ my $tb = Test::Builder::NoOutput->create;
+ $tb->ok(1);
+ $tb->done_testing(2);
+ ok !$tb->is_passing, "All tests passed but done_testing() does not match";
+}
+
+
+# is_passing() with no tests run vs done_testing()
+{
+ my $tb = Test::Builder::NoOutput->create;
+ $tb->done_testing();
+ ok !$tb->is_passing, "No tests run with done_testing()";
+}
+
+
+# is_passing() with no tests run vs done_testing()
+{
+ my $tb = Test::Builder::NoOutput->create;
+ $tb->ok(1);
+ $tb->done_testing();
+ ok $tb->is_passing, "All tests passed with done_testing()";
+}
+
+
+done_testing();
--- /dev/null
+#!/usr/bin/perl
+
+# Test important dependant modules so we don't accidentally half of CPAN.
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ plan skip_all => "Dependents only tested when releasing" unless $ENV{PERL_RELEASING};
+}
+
+use CPAN;
+
+CPAN::HandleConfig->load;
+$CPAN::Config->{test_report} = 0;
+
+# Module which depend on Test::More to test
+my @Modules = qw(
+ Test::Most
+ Test::Warn
+ Test::Exception
+ Test::Class
+ Test::Deep
+ Test::Differences
+);
+
+# Modules which are known to be broken
+my %Broken = map { $_ => 1 } qw(
+ Test::Class
+);
+
+TODO: for my $name (@ARGV ? @ARGV : @Modules) {
+ local $TODO = "$name known to be broken" if $Broken{$name};
+
+ my $module = CPAN::Shell->expand("Module", $name);
+ $module->test;
+ ok( !$module->distribution->{make_test}->failed, $name );
+}
+
+done_testing();
# Test::Builder's own and the ending diagnostics don't come out right.
require Test::Builder;
my $TB = Test::Builder->create;
-$TB->plan(tests => 78);
+$TB->plan(tests => 80);
sub like ($$;$) {
$TB->like(@_);
require Test::More;
our $TODO;
-my $Total = 37;
+my $Total = 38;
Test::More->import(tests => $Total);
$out->read; # clear the plan from $out
# My Wibble isn't a class or reference
ERR
+#line 248
+isa_ok(42, "Wibble");
+out_ok( <<OUT, <<ERR );
+not ok - The thing isa Wibble
+OUT
+# Failed test 'The thing isa Wibble'
+# at $0 line 248.
+# The thing isn't a class or reference
+ERR
+
#line 258
isa_ok(undef, "Wibble", "Another Wibble");
out_ok( <<OUT, <<ERR );
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::Builder;
+
+my $tb = Test::Builder->new;
+
+$tb->ok( !eval { $tb->subtest() } );
+$tb->like( $@, qr/^\Qsubtest()'s second argument must be a code ref/ );
+
+$tb->ok( !eval { $tb->subtest("foo") } );
+$tb->like( $@, qr/^\Qsubtest()'s second argument must be a code ref/ );
+
+$tb->done_testing();
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ( '../lib', 'lib' );
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+use warnings;
+
+use Test::Builder::NoOutput;
+
+use Test::More tests => 23;
+
+# Formatting may change if we're running under Test::Harness.
+$ENV{HARNESS_ACTIVE} = 0;
+
+{
+ my $tb = Test::Builder::NoOutput->create;
+
+ $tb->plan( tests => 7 );
+ for( 1 .. 3 ) {
+ $tb->ok( $_, "We're on $_" );
+ $tb->diag("We ran $_");
+ }
+ {
+ my $indented = $tb->child;
+ $indented->plan('no_plan');
+ $indented->ok( 1, "We're on 1" );
+ $indented->ok( 1, "We're on 2" );
+ $indented->ok( 1, "We're on 3" );
+ $indented->finalize;
+ }
+ for( 7, 8, 9 ) {
+ $tb->ok( $_, "We're on $_" );
+ }
+
+ $tb->reset_outputs;
+ is $tb->read, <<"END", 'Output should nest properly';
+1..7
+ok 1 - We're on 1
+# We ran 1
+ok 2 - We're on 2
+# We ran 2
+ok 3 - We're on 3
+# We ran 3
+ ok 1 - We're on 1
+ ok 2 - We're on 2
+ ok 3 - We're on 3
+ 1..3
+ok 4 - Child of $0
+ok 5 - We're on 7
+ok 6 - We're on 8
+ok 7 - We're on 9
+END
+}
+{
+ my $tb = Test::Builder::NoOutput->create;
+
+ $tb->plan('no_plan');
+ for( 1 .. 1 ) {
+ $tb->ok( $_, "We're on $_" );
+ $tb->diag("We ran $_");
+ }
+ {
+ my $indented = $tb->child;
+ $indented->plan('no_plan');
+ $indented->ok( 1, "We're on 1" );
+ {
+ my $indented2 = $indented->child('with name');
+ $indented2->plan( tests => 2 );
+ $indented2->ok( 1, "We're on 2.1" );
+ $indented2->ok( 1, "We're on 2.1" );
+ $indented2->finalize;
+ }
+ $indented->ok( 1, 'after child' );
+ $indented->finalize;
+ }
+ for(7) {
+ $tb->ok( $_, "We're on $_" );
+ }
+
+ $tb->_ending;
+ $tb->reset_outputs;
+ is $tb->read, <<"END", 'We should allow arbitrary nesting';
+ok 1 - We're on 1
+# We ran 1
+ ok 1 - We're on 1
+ 1..2
+ ok 1 - We're on 2.1
+ ok 2 - We're on 2.1
+ ok 2 - with name
+ ok 3 - after child
+ 1..3
+ok 2 - Child of $0
+ok 3 - We're on 7
+1..3
+END
+}
+
+{
+#line 108
+ my $tb = Test::Builder::NoOutput->create;
+
+ {
+ my $child = $tb->child('expected to fail');
+ $child->plan( tests => 3 );
+ $child->ok(1);
+ $child->ok(0);
+ $child->ok(3);
+ $child->finalize;
+ }
+
+ {
+ my $child = $tb->child('expected to pass');
+ $child->plan( tests => 3 );
+ $child->ok(1);
+ $child->ok(2);
+ $child->ok(3);
+ $child->finalize;
+ }
+ $tb->reset_outputs;
+ is $tb->read, <<"END", 'Previous child failures should not force subsequent failures';
+ 1..3
+ ok 1
+ not ok 2
+ # Failed test at $0 line 114.
+ ok 3
+ # Looks like you failed 1 test of 3.
+not ok 1 - expected to fail
+# Failed test 'expected to fail'
+# at $0 line 116.
+ 1..3
+ ok 1
+ ok 2
+ ok 3
+ok 2 - expected to pass
+END
+}
+{
+ my $tb = Test::Builder::NoOutput->create;
+ my $child = $tb->child('one');
+ is $child->{$_}, $tb->{$_}, "The child should copy the ($_) filehandle"
+ foreach qw{Out_FH Todo_FH Fail_FH};
+ $child->finalize;
+}
+{
+ my $tb = Test::Builder::NoOutput->create;
+ my $child = $tb->child('one');
+ can_ok $child, 'parent';
+ is $child->parent, $tb, '... and it should return the parent of the child';
+ ok !defined $tb->parent, '... but top level builders should not have parents';
+
+ can_ok $tb, 'name';
+ is $tb->name, $0, 'The top level name should be $0';
+ is $child->name, 'one', '... but child names should be whatever we set them to';
+ $child->finalize;
+ $child = $tb->child;
+ is $child->name, 'Child of '.$tb->name, '... or at least have a sensible default';
+ $child->finalize;
+}
+{
+ ok defined &subtest, 'subtest() should be exported to our namespace';
+ is prototype('subtest'), '$&', '... with the appropriate prototype';
+
+ subtest 'subtest with plan', sub {
+ plan tests => 2;
+ ok 1, 'planned subtests should work';
+ ok 1, '... and support more than one test';
+ };
+ subtest 'subtest without plan', sub {
+ plan 'no_plan';
+ ok 1, 'no_plan subtests should work';
+ ok 1, '... and support more than one test';
+ ok 1, '... no matter how many tests are run';
+ };
+}
+# Skip all subtests
+{
+ my $tb = Test::Builder::NoOutput->create;
+
+ {
+ my $child = $tb->child('skippy says he loves you');
+ eval { $child->plan( skip_all => 'cuz I said so' ) };
+ ok my $error = $@, 'A child which does a "skip_all" should throw an exception';
+ isa_ok $error, 'Test::Builder::Exception', '... and the exception it throws';
+ }
+ subtest 'skip all', sub {
+ plan skip_all => 'subtest with skip_all';
+ ok 0, 'This should never be run';
+ };
+ is +Test::Builder->new->{Test_Results}[-1]{type}, 'skip',
+ 'Subtests which "skip_all" are reported as skipped tests';
+}
+
+# to do tests
+{
+#line 204
+ my $tb = Test::Builder::NoOutput->create;
+ $tb->plan( tests => 1 );
+ my $child = $tb->child;
+ $child->plan( tests => 1 );
+ $child->todo_start( 'message' );
+ $child->ok( 0 );
+ $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
+ not ok 1 # TODO message
+ # Failed (TODO) test at $0 line 209.
+ok 1 - Child of $0
+END
+}
+{
+ my $tb = Test::Builder::NoOutput->create;
+ $tb->plan( tests => 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"
+END
+ like $tb->read, qr/\Q$expected/,
+ 'Not running subtests should make the parent test fail';
+}
--- /dev/null
+#!/usr/bin/perl -w
+
+# What happens when a subtest dies?
+
+use lib 't/lib';
+
+use strict;
+use Test::Builder;
+use Test::Builder::NoOutput;
+
+my $Test = Test::Builder->new;
+
+{
+ my $tb = Test::Builder::NoOutput->create;
+
+ $tb->ok(1);
+
+ $Test->ok( !eval {
+ $tb->subtest("death" => sub {
+ die "Death in the subtest";
+ });
+ 1;
+ });
+ $Test->like( $@, qr/^Death in the subtest at $0 line /);
+
+ $Test->ok( !$tb->parent, "the parent object is restored after a die" );
+}
+
+
+$Test->done_testing();
--- /dev/null
+#!/usr/bin/perl -w
+
+# Test the idiom of running another test file as a subtest.
+
+use strict;
+use Test::More;
+
+pass("First");
+
+my $file = "t/subtest/for_do_t.test";
+ok -e $file, "subtest test file exists";
+
+subtest $file => sub { do $file };
+
+pass("Last");
+
+done_testing(4);
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ( '../lib', 'lib' );
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+use warnings;
+use Test::Builder::NoOutput;
+use Test::More tests => 7;
+
+{
+ my $tb = Test::Builder::NoOutput->create;
+ $tb->child('one');
+ eval { $tb->child('two') };
+ my $error = $@;
+ like $error, qr/\QYou already have a child named (one) running/,
+ 'Trying to create a child with another one active should fail';
+}
+{
+ my $tb = Test::Builder::NoOutput->create;
+ my $child = $tb->child('one');
+ ok my $child2 = $child->child('two'), 'Trying to create nested children should succeed';
+ eval { $child->finalize };
+ my $error = $@;
+ like $error, qr/\QCan't call finalize() with child (two) active/,
+ '... but trying to finalize() a child with open children should fail';
+}
+{
+ my $tb = Test::Builder::NoOutput->create;
+ my $child = $tb->child('one');
+ undef $child;
+ like $tb->read, qr/\QChild (one) exited without calling finalize()/,
+ 'Failing to call finalize should issue an appropriate diagnostic';
+ ok !$tb->is_passing, '... and should cause the test suite to fail';
+}
+{
+ my $tb = Test::Builder::NoOutput->create;
+
+ $tb->plan( tests => 7 );
+ for( 1 .. 3 ) {
+ $tb->ok( $_, "We're on $_" );
+ $tb->diag("We ran $_");
+ }
+ {
+ my $indented = $tb->child;
+ $indented->plan('no_plan');
+ $indented->ok( 1, "We're on 1" );
+ eval { $tb->ok( 1, 'This should throw an exception' ) };
+ $indented->finalize;
+ }
+
+ my $error = $@;
+ like $error, qr/\QCannot run test (This should throw an exception) with active children/,
+ 'Running a test with active children should fail';
+ ok !$tb->is_passing, '... and should cause the test suite to fail';
+}
--- /dev/null
+# Test used by t/subtest/do.t
+
+use Test::More;
+
+pass("First");
+pass("Second");
+pass("Third");
+
+done_testing(3);
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ( '../lib', 'lib' );
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+{
+
+ package Test::Singleton;
+
+ use Test::Builder;
+ my $TB = Test::Builder->new;
+
+ sub singleton_ok ($;$) {
+ my( $val, $name ) = @_;
+ $TB->ok( $val, $name );
+ }
+}
+
+ok 1, 'TB top level';
+subtest 'doing a subtest' => sub {
+ plan tests => 4;
+ ok 1, 'first test in subtest';
+ Test::Singleton::singleton_ok(1, 'this should not fail');
+ ok 1, 'second test in subtest';
+ Test::Singleton::singleton_ok(1, 'this should not fail');
+};
+ok 1, 'left subtest';
my $tb = Test::More->builder;
-my $err;
+my $err = '';
$tb->failure_output(\$err);
diag(undef);
$tb->reset_outputs;
require Test::Builder::Module;
require Test::Simple;
-my $dist_version = $Test::More::VERSION;
+my $dist_version = Test::More->VERSION;
like( $dist_version, qr/^ \d+ \. \d+ $/x );
-is( $dist_version, $Test::Builder::VERSION, 'Test::Builder' );
-is( $dist_version, $Test::Builder::Module::VERSION, 'TB::Module' );
-is( $dist_version, $Test::Simple::VERSION, 'Test::Simple' );
+
+my @modules = qw(
+ Test::Simple
+ Test::Builder
+ Test::Builder::Module
+);
+
+for my $module (@modules) {
+ is( $dist_version, $module->VERSION, $module );
+}
done_testing(4);
projects / p5sagit/p5-mst-13.2.git / commitdiff