From 2c4d5b9bac4cc2611594b42e08eeb35c67ab35ac Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sat, 10 Oct 2009 13:11:04 +0100 Subject: Upgrade to Test-Simple-0.94 --- cpan/Test-Simple/Changes | 37 +++- cpan/Test-Simple/examples/indent.pl | 36 ++++ cpan/Test-Simple/examples/subtest.t | 19 ++ cpan/Test-Simple/lib/Test/Builder.pm | 308 +++++++++++++++++++++++++--- cpan/Test-Simple/lib/Test/Builder/Module.pm | 12 +- cpan/Test-Simple/lib/Test/Builder/Tester.pm | 33 +-- cpan/Test-Simple/lib/Test/More.pm | 71 +++++-- cpan/Test-Simple/lib/Test/Simple.pm | 8 +- cpan/Test-Simple/lib/Test/Tutorial.pod | 15 +- cpan/Test-Simple/t/00compile.t | 43 ++++ cpan/Test-Simple/t/Builder/create.t | 2 - cpan/Test-Simple/t/Builder/is_passing.t | 106 ++++++++++ cpan/Test-Simple/t/dependents.t | 42 ++++ cpan/Test-Simple/t/fail-more.t | 14 +- cpan/Test-Simple/t/subtest/args.t | 14 ++ cpan/Test-Simple/t/subtest/basic.t | 235 +++++++++++++++++++++ cpan/Test-Simple/t/subtest/die.t | 30 +++ cpan/Test-Simple/t/subtest/do.t | 17 ++ cpan/Test-Simple/t/subtest/exceptions.t | 63 ++++++ cpan/Test-Simple/t/subtest/for_do_t.test | 9 + cpan/Test-Simple/t/subtest/singleton.t | 38 ++++ cpan/Test-Simple/t/undef.t | 2 +- cpan/Test-Simple/t/versions.t | 15 +- 23 files changed, 1068 insertions(+), 101 deletions(-) create mode 100644 cpan/Test-Simple/examples/indent.pl create mode 100644 cpan/Test-Simple/examples/subtest.t create mode 100644 cpan/Test-Simple/t/00compile.t create mode 100644 cpan/Test-Simple/t/Builder/is_passing.t create mode 100644 cpan/Test-Simple/t/dependents.t create mode 100644 cpan/Test-Simple/t/subtest/args.t create mode 100644 cpan/Test-Simple/t/subtest/basic.t create mode 100644 cpan/Test-Simple/t/subtest/die.t create mode 100644 cpan/Test-Simple/t/subtest/do.t create mode 100644 cpan/Test-Simple/t/subtest/exceptions.t create mode 100644 cpan/Test-Simple/t/subtest/for_do_t.test create mode 100644 cpan/Test-Simple/t/subtest/singleton.t (limited to 'cpan/Test-Simple') diff --git a/cpan/Test-Simple/Changes b/cpan/Test-Simple/Changes index 0c955f2908..33bbdbb7a2 100644 --- a/cpan/Test-Simple/Changes +++ b/cpan/Test-Simple/Changes @@ -1,26 +1,49 @@ +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. diff --git a/cpan/Test-Simple/examples/indent.pl b/cpan/Test-Simple/examples/indent.pl new file mode 100644 index 0000000000..e55e180e34 --- /dev/null +++ b/cpan/Test-Simple/examples/indent.pl @@ -0,0 +1,36 @@ +#!/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 $_" ); +} diff --git a/cpan/Test-Simple/examples/subtest.t b/cpan/Test-Simple/examples/subtest.t new file mode 100644 index 0000000000..789d1a4b9c --- /dev/null +++ b/cpan/Test-Simple/examples/subtest.t @@ -0,0 +1,19 @@ +#!/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; diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm index cd5779f75b..26ffea41ff 100644 --- a/cpan/Test-Simple/lib/Test/Builder.pm +++ b/cpan/Test-Simple/lib/Test/Builder.pm @@ -4,7 +4,7 @@ use 5.006; use strict; use warnings; -our $VERSION = '0.92'; +our $VERSION = '0.94'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) BEGIN { @@ -116,7 +116,7 @@ singleton, use C. =cut -my $Test = Test::Builder->new; +our $Test = Test::Builder->new; sub new { my($class) = shift; @@ -147,6 +147,184 @@ sub create { return $self; } +=item B + + my $child = $builder->child($name_of_child); + $child->plan( tests => 4 ); + $child->ok(some_code()); + ... + $child->finalize; + +Returns a new instance of C. Any output from this child will +indented four spaces more than the parent's indentation. When done, the +C method I be called explicitly. + +Trying to create a new child with a previous child still active (i.e., +C not called) will C. + +Trying to run a test when you have an open child will also C 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 + + $builder->subtest($name, \&subtests); + +See documentation of C 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 + + my $ok = $child->finalize; + +When your child is done running tests, you must call C to clean up +and tell the parent your pass/fail status. + +Calling finalize on a child with open children will C. + +If the child falls out of scope before C 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 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 + + if ( my $parent = $builder->parent ) { + ... + } + +Returns the parent C instance, if any. Only used with child +builders for nested TAP. + +=cut + +sub parent { shift->{Parent} } + +=item B + + 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 +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 $Test->reset; @@ -166,11 +344,16 @@ sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms) # 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; @@ -216,6 +399,18 @@ will print the appropriate headers and take the appropriate actions. If you call C, don't call any of the other methods below. +If a child calls "skip_all" in the plan, a C is +thrown. Trap this error, call C 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 = ( @@ -414,6 +609,12 @@ sub done_testing { $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; } @@ -448,9 +649,12 @@ Skips all the tests, using the given C<$reason>. Exits immediately with 0. 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); } @@ -500,6 +704,11 @@ like Test::Simple's C. 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; @@ -575,9 +784,27 @@ ERR } } + $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; @@ -784,8 +1011,6 @@ sub isnt_num { Like Test::More's C. Checks if $this matches the given C<$regex>. -You'll want to avoid C if you want your tests to work before 5.005. - =item B $Test->unlike($this, qr/$regex/, $name); @@ -932,7 +1157,10 @@ BAIL_OUT() used to be BAILOUT() =cut -*BAILOUT = \&BAIL_OUT; +{ + no warnings 'once'; + *BAILOUT = \&BAIL_OUT; +} =item B @@ -1039,8 +1267,11 @@ These methods are useful when writing your own test methods. $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, or a string representing a regular expression. @@ -1109,15 +1340,11 @@ sub _regex_ok { ## 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 '!~'; @@ -1199,8 +1426,7 @@ sub is_fh { 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 @@ -1469,7 +1695,7 @@ sub _print_to_fh { # 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 @@ -1727,6 +1953,34 @@ sub current_test { return $self->{Curr_Test}; } +=item B + + 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 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 my @tests = $Test->summary; @@ -2036,10 +2290,10 @@ WHOA _my_exit($exit_num); -Perl seems to have some trouble with exiting inside an C block. 5.005_03 -and 5.6.1 both seem to do odd things. Instead, this function edits C<$?> -directly. It should B be called from inside an C block. It -doesn't actually exit, that's your job. +Perl seems to have some trouble with exiting inside an C block. +5.6.1 does some odd things. Instead, this function edits C<$?> +directly. It should B be called from inside an C block. +It doesn't actually exit, that's your job. =cut @@ -2057,6 +2311,8 @@ sub _my_exit { sub _ending { my $self = shift; + return if $self->no_ending; + return if $self->{Ending}++; my $real_exit_code = $?; @@ -2068,6 +2324,7 @@ sub _ending { # 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."); } @@ -2079,9 +2336,9 @@ sub _ending { # 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) { @@ -2109,6 +2366,7 @@ sub _ending { $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) { @@ -2120,13 +2378,14 @@ FAIL $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; } @@ -2150,18 +2409,21 @@ FAIL $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 diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm index a2d8e5bb60..4f7d1aa7db 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Module.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Module.pm @@ -7,17 +7,9 @@ use Test::Builder; 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 @@ -98,7 +90,7 @@ sub import { $test->plan(@_); - $class->$_export_to_level( 1, $class, @imports ); + $class->export_to_level( 1, $class, @imports ); } sub _strip_imports { diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester.pm b/cpan/Test-Simple/lib/Test/Builder/Tester.pm index c019635584..7bea6f99da 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester.pm @@ -59,18 +59,6 @@ our @ISA = qw(Exporter); 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) = @_; @@ -88,7 +76,7 @@ sub import { } } - __PACKAGE__->_export_to_level( 1, __PACKAGE__, @imports ); + __PACKAGE__->export_to_level( 1, __PACKAGE__, @imports ); } ### @@ -399,13 +387,11 @@ your original tests. Also, it may be hard to spot things like 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 module installed -(which you should do by default from perl 5.005 onwards), C -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 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 function determines if colouring should occur or not. Passing it a true or false value will enable or disable colouring @@ -438,8 +424,8 @@ This is needed as otherwise it will trip out because we've run more 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 is installed -and is compatible with your terminal. +The color function doesn't work unless B is +compatible with your terminal. Bugs (and requests for new features) can be reported to the author though the CPAN RT system: @@ -459,9 +445,6 @@ and/or modify it under the same terms as Perl itself. =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 Erichardc@unixbeard.netE for letting me use his testing system to try this module out on. diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm index aaf6d8721b..6728487469 100644 --- a/cpan/Test-Simple/lib/Test/More.pm +++ b/cpan/Test-Simple/lib/Test/More.pm @@ -17,7 +17,7 @@ sub _carp { 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; @@ -33,6 +33,7 @@ our @EXPORT = qw(ok use_ok require_ok done_testing can_ok isa_ok new_ok diag note explain + subtest BAIL_OUT ); @@ -243,7 +244,6 @@ exponential". 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 @@ -596,6 +596,7 @@ sub isa_ok ($$;$) { } 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 { @@ -672,6 +673,58 @@ sub new_ok { return $obj; } +=item B + + 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 =item B @@ -1213,9 +1266,6 @@ and you'll know immediately when they're fixed. Once a todo test starts succeeding, simply move it outside the block. When the block is empty, delete it. -B: TODO tests require a Test::Harness upgrade else it will -treat it as a normal failure. See L). - =item B @@ -1649,17 +1699,6 @@ This may cause problems: 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 diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm index 48c72e27fc..9c8716759a 100644 --- a/cpan/Test-Simple/lib/Test/Simple.pm +++ b/cpan/Test-Simple/lib/Test/Simple.pm @@ -1,10 +1,10 @@ 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; @@ -162,9 +162,9 @@ Unfortunately, I can't differentiate any further. =head1 NOTES -Test::Simple is B tested all the way back to perl 5.004. +Test::Simple is B 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 diff --git a/cpan/Test-Simple/lib/Test/Tutorial.pod b/cpan/Test-Simple/lib/Test/Tutorial.pod index b730918c75..46ac467dda 100644 --- a/cpan/Test-Simple/lib/Test/Tutorial.pod +++ b/cpan/Test-Simple/lib/Test/Tutorial.pod @@ -266,7 +266,7 @@ or we could set up a little try/expect loop. 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 ], @@ -311,7 +311,9 @@ function. ); # 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. This means we're just running some tests, don't know how many. [6] @@ -376,11 +378,10 @@ F [7] 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 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; diff --git a/cpan/Test-Simple/t/00compile.t b/cpan/Test-Simple/t/00compile.t new file mode 100644 index 0000000000..e282878c1f --- /dev/null +++ b/cpan/Test-Simple/t/00compile.t @@ -0,0 +1,43 @@ +#!/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); + } +} diff --git a/cpan/Test-Simple/t/Builder/create.t b/cpan/Test-Simple/t/Builder/create.t index d584b30955..64be8511d8 100644 --- a/cpan/Test-Simple/t/Builder/create.t +++ b/cpan/Test-Simple/t/Builder/create.t @@ -1,7 +1,5 @@ #!/usr/bin/perl -w -#!perl -w - BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/cpan/Test-Simple/t/Builder/is_passing.t b/cpan/Test-Simple/t/Builder/is_passing.t new file mode 100644 index 0000000000..d335aada57 --- /dev/null +++ b/cpan/Test-Simple/t/Builder/is_passing.t @@ -0,0 +1,106 @@ +#!/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(); diff --git a/cpan/Test-Simple/t/dependents.t b/cpan/Test-Simple/t/dependents.t new file mode 100644 index 0000000000..64efca1cd4 --- /dev/null +++ b/cpan/Test-Simple/t/dependents.t @@ -0,0 +1,42 @@ +#!/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(); diff --git a/cpan/Test-Simple/t/fail-more.t b/cpan/Test-Simple/t/fail-more.t index 423e216488..06a2562260 100644 --- a/cpan/Test-Simple/t/fail-more.t +++ b/cpan/Test-Simple/t/fail-more.t @@ -24,7 +24,7 @@ package My::Test; # 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(@_); @@ -51,7 +51,7 @@ package main; require Test::More; our $TODO; -my $Total = 37; +my $Total = 38; Test::More->import(tests => $Total); $out->read; # clear the plan from $out @@ -256,6 +256,16 @@ OUT # My Wibble isn't a class or reference ERR +#line 248 +isa_ok(42, "Wibble"); +out_ok( <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(); diff --git a/cpan/Test-Simple/t/subtest/basic.t b/cpan/Test-Simple/t/subtest/basic.t new file mode 100644 index 0000000000..b9846bea75 --- /dev/null +++ b/cpan/Test-Simple/t/subtest/basic.t @@ -0,0 +1,235 @@ +#!/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'; +} diff --git a/cpan/Test-Simple/t/subtest/die.t b/cpan/Test-Simple/t/subtest/die.t new file mode 100644 index 0000000000..7965e9088b --- /dev/null +++ b/cpan/Test-Simple/t/subtest/die.t @@ -0,0 +1,30 @@ +#!/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(); diff --git a/cpan/Test-Simple/t/subtest/do.t b/cpan/Test-Simple/t/subtest/do.t new file mode 100644 index 0000000000..40b950184e --- /dev/null +++ b/cpan/Test-Simple/t/subtest/do.t @@ -0,0 +1,17 @@ +#!/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); diff --git a/cpan/Test-Simple/t/subtest/exceptions.t b/cpan/Test-Simple/t/subtest/exceptions.t new file mode 100644 index 0000000000..92d65b648a --- /dev/null +++ b/cpan/Test-Simple/t/subtest/exceptions.t @@ -0,0 +1,63 @@ +#!/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'; +} diff --git a/cpan/Test-Simple/t/subtest/for_do_t.test b/cpan/Test-Simple/t/subtest/for_do_t.test new file mode 100644 index 0000000000..413923bceb --- /dev/null +++ b/cpan/Test-Simple/t/subtest/for_do_t.test @@ -0,0 +1,9 @@ +# Test used by t/subtest/do.t + +use Test::More; + +pass("First"); +pass("Second"); +pass("Third"); + +done_testing(3); diff --git a/cpan/Test-Simple/t/subtest/singleton.t b/cpan/Test-Simple/t/subtest/singleton.t new file mode 100644 index 0000000000..0c25261f5b --- /dev/null +++ b/cpan/Test-Simple/t/subtest/singleton.t @@ -0,0 +1,38 @@ +#!/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'; diff --git a/cpan/Test-Simple/t/undef.t b/cpan/Test-Simple/t/undef.t index 2e9201c3b4..0436364d7f 100644 --- a/cpan/Test-Simple/t/undef.t +++ b/cpan/Test-Simple/t/undef.t @@ -78,7 +78,7 @@ warnings_like(qr/Use of uninitialized value.* at cmp_ok \[from $Filename line 64 my $tb = Test::More->builder; -my $err; +my $err = ''; $tb->failure_output(\$err); diag(undef); $tb->reset_outputs; diff --git a/cpan/Test-Simple/t/versions.t b/cpan/Test-Simple/t/versions.t index e41e7ce3e0..cb83599364 100644 --- a/cpan/Test-Simple/t/versions.t +++ b/cpan/Test-Simple/t/versions.t @@ -11,11 +11,18 @@ require Test::Builder; 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); -- cgit v1.2.1