diff options
author | Steve Hay <steve.m.hay@googlemail.com> | 2013-10-18 01:34:47 +0100 |
---|---|---|
committer | Steve Hay <steve.m.hay@googlemail.com> | 2013-10-18 01:35:52 +0100 |
commit | 411e93ce65da156b2ffd45afeee2d4beebd3824a (patch) | |
tree | 86fb1df4cbb2381c859a8ffcbb42861304dd6d35 /cpan | |
parent | d70bfb04654edb2c690488bcaace7a1c7090004d (diff) | |
download | perl-411e93ce65da156b2ffd45afeee2d4beebd3824a.tar.gz |
Upgrade Test-Simple from version 0.98 to 0.99
This incorporates the CUSTOMIZED files t/fail-more.t, lib/Test/Builder.pm,
lib/Test/Builder/Module.pm, lib/Test/More.pm and lib/Test/Simple.pm.
Diffstat (limited to 'cpan')
27 files changed, 858 insertions, 362 deletions
diff --git a/cpan/Test-Simple/Changes b/cpan/Test-Simple/Changes index b60952ecd2..c67510c729 100644 --- a/cpan/Test-Simple/Changes +++ b/cpan/Test-Simple/Changes @@ -1,3 +1,98 @@ +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) diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm index 762fa78d83..847a26c739 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.98_06'; +our $VERSION = '0.99'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) BEGIN { @@ -147,6 +147,20 @@ sub create { 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); @@ -179,15 +193,20 @@ sub 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 @@ -220,17 +239,22 @@ sub subtest { # 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; @@ -242,8 +266,8 @@ sub subtest { } # 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}); @@ -252,7 +276,11 @@ sub subtest { 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 @@ -322,14 +350,16 @@ sub finalize { 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}; @@ -415,7 +445,6 @@ sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms) $self->{Child_Name} = undef; $self->{Indent} ||= ''; - share( $self->{Curr_Test} ); $self->{Curr_Test} = 0; $self->{Test_Results} = &share( [] ); @@ -434,11 +463,25 @@ sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms) $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 @@ -633,7 +676,7 @@ Or to plan a variable number of tests: for my $test (@tests) { $Test->ok($test); } - $Test->done_testing(@tests); + $Test->done_testing(scalar @tests); =cut @@ -1065,38 +1108,38 @@ sub isnt_num { =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()>. @@ -1106,9 +1149,16 @@ 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; { @@ -1208,6 +1258,13 @@ sub BAIL_OUT { 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; } @@ -1343,11 +1400,11 @@ For example, a version of C<like()>, sans the useful diagnostic messages, 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 @@ -1385,7 +1442,7 @@ sub _is_qr { } 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); @@ -1397,14 +1454,19 @@ sub _regex_ok { } { - ## 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 '!~'; @@ -1413,11 +1475,11 @@ sub _regex_ok { } 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 @@ -2402,6 +2464,26 @@ sub _ending { 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" diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm index 446dfcc157..24a9d55bed 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Module.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Module.pm @@ -2,12 +2,12 @@ package Test::Builder::Module; 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) diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester.pm b/cpan/Test-Simple/lib/Test/Builder/Tester.pm index 793139f795..299ee521f0 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester.pm @@ -1,9 +1,9 @@ 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; @@ -98,15 +98,13 @@ my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; # 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 @@ -134,6 +132,8 @@ sub _start_testing { $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); @@ -222,7 +222,7 @@ sub test_fail { $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 @@ -268,7 +268,7 @@ sub 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. @@ -329,6 +329,7 @@ sub test_test { # 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; @@ -435,7 +436,7 @@ L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Builder-Tester> 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. @@ -469,11 +470,19 @@ sub expect { 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 ) = @_; @@ -511,7 +520,7 @@ sub complaint { 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) { diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm index 9fb6cf15a8..b269a2783d 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm @@ -1,7 +1,7 @@ package Test::Builder::Tester::Color; use strict; -our $VERSION = "1.22"; +our $VERSION = "1.23_002"; require Test::Builder::Tester; diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm index 97dc7acd09..ad3cf50673 100644 --- a/cpan/Test-Simple/lib/Test/More.pm +++ b/cpan/Test-Simple/lib/Test/More.pm @@ -17,10 +17,10 @@ sub _carp { 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 @@ -49,7 +49,6 @@ Test::More - yet another framework for writing test scripts # or use Test::More; # see done_testing() - BEGIN { use_ok( 'Some::Module' ); } require_ok( 'Some::Module' ); # Various ways to say "ok" @@ -269,7 +268,7 @@ For example: 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.") @@ -318,7 +317,7 @@ are similar to these: 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"); @@ -397,7 +396,7 @@ So this: is similar to: - ok( $got =~ /expected/, 'this is like that'); + ok( $got =~ m/expected/, 'this is like that'); (Mnemonic "This is like that".) @@ -440,8 +439,9 @@ sub unlike ($$;$) { 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' ); @@ -577,59 +577,81 @@ you'd like them to be more specific, you can supply an $object_name =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; } @@ -662,7 +684,6 @@ sub new_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 } ); @@ -671,7 +692,8 @@ sub new_ok { 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"); } @@ -705,6 +727,7 @@ This would produce. 1..3 ok 1 - First test + # Subtest: An example subtest 1..2 ok 1 - This is a subtest ok 2 - So is this @@ -781,21 +804,101 @@ sub fail (;$) { =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: @@ -829,7 +932,6 @@ import anything, use C<require_ok>. BEGIN { require_ok "Foo" } - =cut sub use_ok ($;@) { @@ -838,6 +940,7 @@ 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+)?$/ ) { @@ -845,6 +948,8 @@ sub use_ok ($;@) { # for it to work with non-Exporter based modules. $code = <<USE; package $pack; + +#line $line $filename use $module $imports[0]; 1; USE @@ -852,6 +957,8 @@ USE else { $code = <<USE; package $pack; + +#line $line $filename use $module \@{\$args[0]}; 1; USE @@ -892,56 +999,6 @@ sub _eval { 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 @@ -1121,7 +1178,7 @@ You might remember C<ok() or diag()> with the mnemonic C<open() or 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> @@ -1685,14 +1742,45 @@ If you fail more than 254 tests, it will be reported as 254. 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" @@ -1703,13 +1791,19 @@ Test::More) duplicates STDOUT and STDERR. So any changes to them, 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 diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm index 13c474ff0a..411b38ba00 100644 --- a/cpan/Test-Simple/lib/Test/Simple.pm +++ b/cpan/Test-Simple/lib/Test/Simple.pm @@ -4,10 +4,10 @@ use 5.006; 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); diff --git a/cpan/Test-Simple/lib/Test/Tutorial.pod b/cpan/Test-Simple/lib/Test/Tutorial.pod index 46ac467dda..b89fd07ca5 100644 --- a/cpan/Test-Simple/lib/Test/Tutorial.pod +++ b/cpan/Test-Simple/lib/Test/Tutorial.pod @@ -5,8 +5,8 @@ Test::Tutorial - A tutorial about writing really basic tests =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*> @@ -16,7 +16,7 @@ I<Besides, I don't know how to write the damned things.> 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 @@ -36,7 +36,7 @@ Here's the most basic test program. 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 @@ -44,11 +44,11 @@ since 1 + 1 is 2, it prints: 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 @@ -56,7 +56,7 @@ there's B<Test::Simple>. It has one function, C<ok()>. 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. @@ -67,7 +67,7 @@ fails. ok( 1 + 1 == 2 ); ok( 2 + 2 == 5 ); -from that comes +From that comes: 1..2 ok 1 @@ -75,28 +75,31 @@ from that comes # 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; @@ -105,19 +108,19 @@ object. So we test C<new()>. 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()>. @@ -127,7 +130,7 @@ 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 @@ -136,8 +139,8 @@ So now you'd see... =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 @@ -146,20 +149,20 @@ L<Date::ICal/SYNOPSIS> and test that all its bits work. 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 @@ -173,45 +176,42 @@ run that and you get: 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 @@ -227,24 +227,24 @@ you get some more information 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. @@ -289,16 +289,16 @@ or we could set up a little try/expect loop. 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. @@ -315,22 +315,28 @@ 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') @@ -342,8 +348,8 @@ itself we're trying out to the name. So you get results like: 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 @@ -377,11 +383,12 @@ F<t/01sanity.t> [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] 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; @@ -391,7 +398,7 @@ we can explicitly say it's never going to work and skip the test. 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" ); @@ -407,11 +414,11 @@ we can explicitly say it's never going to work and skip the test. 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 @@ -422,7 +429,7 @@ the tests have been skipped. 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 @@ -439,7 +446,7 @@ The tests are wholly and completely skipped. [10] This will work. =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 @@ -448,8 +455,8 @@ Thumbing through the Date::ICal man page, I came across this: 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; @@ -458,7 +465,7 @@ the date in the Date::ICal test suite. So I'll write one. $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() @@ -467,10 +474,10 @@ run that and I get # 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; @@ -490,14 +497,14 @@ Now when you run, it's a little different: # 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. @@ -510,15 +517,14 @@ in mind, it's very important to ensure your module works under taint 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 @@ -538,7 +544,7 @@ some bugs, which is good -- we'll uncover them with our tests. =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 @@ -552,7 +558,7 @@ We'll get to testing the contents of lists later. 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. diff --git a/cpan/Test-Simple/t/Tester/tbt_08subtest.t b/cpan/Test-Simple/t/Tester/tbt_08subtest.t new file mode 100644 index 0000000000..6ec508f247 --- /dev/null +++ b/cpan/Test-Simple/t/Tester/tbt_08subtest.t @@ -0,0 +1,16 @@ +#!/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"); +}; diff --git a/cpan/Test-Simple/t/Tester/tbt_09do.t b/cpan/Test-Simple/t/Tester/tbt_09do.t new file mode 100644 index 0000000000..a0c8b8e2e5 --- /dev/null +++ b/cpan/Test-Simple/t/Tester/tbt_09do.t @@ -0,0 +1,21 @@ +#!/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) + } +}; diff --git a/cpan/Test-Simple/t/Tester/tbt_09do_script.pl b/cpan/Test-Simple/t/Tester/tbt_09do_script.pl new file mode 100644 index 0000000000..590a03b085 --- /dev/null +++ b/cpan/Test-Simple/t/Tester/tbt_09do_script.pl @@ -0,0 +1,13 @@ +#!/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; diff --git a/cpan/Test-Simple/t/cmp_ok.t b/cpan/Test-Simple/t/cmp_ok.t index de1a7e634d..c9b9f1bf65 100644 --- a/cpan/Test-Simple/t/cmp_ok.t +++ b/cpan/Test-Simple/t/cmp_ok.t @@ -1,16 +1,9 @@ #!/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(); @@ -21,18 +14,33 @@ my $TB = Test::Builder->create; $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" ); @@ -65,6 +73,9 @@ my @Tests = ( [$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; diff --git a/cpan/Test-Simple/t/dependents.t b/cpan/Test-Simple/t/dependents.t index 6699212b63..58b901e0c2 100644 --- a/cpan/Test-Simple/t/dependents.t +++ b/cpan/Test-Simple/t/dependents.t @@ -30,7 +30,6 @@ my @Modules = qw( # Modules which are known to be broken my %Broken = map { $_ => 1 } qw( - Test::Class ); TODO: for my $name (@ARGV ? @ARGV : @Modules) { diff --git a/cpan/Test-Simple/t/exit.t b/cpan/Test-Simple/t/exit.t index 95661eef07..2b17ce06a8 100644 --- a/cpan/Test-Simple/t/exit.t +++ b/cpan/Test-Simple/t/exit.t @@ -87,6 +87,8 @@ my %Tests = ( 'require.plx' => 0, 'death_with_handler.plx' => 255, 'exit.plx' => 1, + 'one_fail_without_plan.plx' => 1, + 'missing_done_testing.plx' => 254, ); chdir 't'; diff --git a/cpan/Test-Simple/t/fail-more.t b/cpan/Test-Simple/t/fail-more.t index 72b5a518cc..5c35d49bd3 100644 --- a/cpan/Test-Simple/t/fail-more.t +++ b/cpan/Test-Simple/t/fail-more.t @@ -239,59 +239,59 @@ ERR #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 @@ -299,9 +299,9 @@ 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 @@ -314,41 +314,41 @@ 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 diff --git a/cpan/Test-Simple/t/is_deeply_fail.t b/cpan/Test-Simple/t/is_deeply_fail.t index fc1c6b617c..26036fb960 100644 --- a/cpan/Test-Simple/t/is_deeply_fail.t +++ b/cpan/Test-Simple/t/is_deeply_fail.t @@ -33,22 +33,22 @@ sub ok ($;$) { } 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; } @@ -418,4 +418,4 @@ ERR 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 +} diff --git a/cpan/Test-Simple/t/lib/Test/Builder/NoOutput.pm b/cpan/Test-Simple/t/lib/Test/Builder/NoOutput.pm index d83db9f178..bbdf73268f 100644 --- a/cpan/Test-Simple/t/lib/Test/Builder/NoOutput.pm +++ b/cpan/Test-Simple/t/lib/Test/Builder/NoOutput.pm @@ -3,6 +3,7 @@ package Test::Builder::NoOutput; use strict; use warnings; +use Symbol qw(gensym); use base qw(Test::Builder); @@ -60,17 +61,19 @@ sub create { ); $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'; diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/missing_done_testing.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/missing_done_testing.plx new file mode 100644 index 0000000000..d1b576c90d --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/missing_done_testing.plx @@ -0,0 +1,8 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(); +ok(1); diff --git a/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/one_fail_without_plan.plx b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/one_fail_without_plan.plx new file mode 100644 index 0000000000..8b276cae0a --- /dev/null +++ b/cpan/Test-Simple/t/lib/Test/Simple/sample_tests/one_fail_without_plan.plx @@ -0,0 +1,8 @@ +require Test::Simple; + +push @INC, 't/lib'; +require Test::Simple::Catch; +my($out, $err) = Test::Simple::Catch::caught(); + +Test::Simple->import(); +ok(0); diff --git a/cpan/Test-Simple/t/subtest/bail_out.t b/cpan/Test-Simple/t/subtest/bail_out.t new file mode 100644 index 0000000000..70dc9ac56f --- /dev/null +++ b/cpan/Test-Simple/t/subtest/bail_out.t @@ -0,0 +1,59 @@ +#!/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 ); diff --git a/cpan/Test-Simple/t/subtest/basic.t b/cpan/Test-Simple/t/subtest/basic.t index 0a0a96273a..93780a9da2 100644 --- a/cpan/Test-Simple/t/subtest/basic.t +++ b/cpan/Test-Simple/t/subtest/basic.t @@ -40,7 +40,6 @@ $ENV{HARNESS_ACTIVE} = 0; $tb->ok( $_, "We're on $_" ); } - $tb->reset_outputs; is $tb->read, <<"END", 'Output should nest properly'; 1..7 ok 1 - We're on 1 @@ -86,7 +85,6 @@ END } $tb->_ending; - $tb->reset_outputs; is $tb->read, <<"END", 'We should allow arbitrary nesting'; ok 1 - We're on 1 # We ran 1 @@ -124,7 +122,6 @@ END $child->ok(3); $child->finalize; } - $tb->reset_outputs; is $tb->read, <<"END", 'Previous child failures should not force subsequent failures'; 1..3 ok 1 @@ -194,7 +191,6 @@ END $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 @@ -209,7 +205,6 @@ END 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" diff --git a/cpan/Test-Simple/t/subtest/line_numbers.t b/cpan/Test-Simple/t/subtest/line_numbers.t index 33d70ecee0..7a20a60ae6 100644 --- a/cpan/Test-Simple/t/subtest/line_numbers.t +++ b/cpan/Test-Simple/t/subtest/line_numbers.t @@ -26,6 +26,7 @@ $ENV{HARNESS_ACTIVE} = 0; our %line; { + test_out(" # Subtest: namehere"); test_out(" 1..3"); test_out(" ok 1"); test_out(" not ok 2"); @@ -46,6 +47,7 @@ our %line; 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"); @@ -76,6 +78,7 @@ sub run_the_subtest { }; 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"); @@ -92,6 +95,7 @@ sub run_the_subtest { 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"'); @@ -105,6 +109,7 @@ sub run_the_subtest { 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'"); diff --git a/cpan/Test-Simple/t/subtest/predicate.t b/cpan/Test-Simple/t/subtest/predicate.t index 9fbdf00ca2..4e29a426b1 100644 --- a/cpan/Test-Simple/t/subtest/predicate.t +++ b/cpan/Test-Simple/t/subtest/predicate.t @@ -16,7 +16,7 @@ BEGIN { use strict; use warnings; -use Test::More tests => 4; +use Test::More tests => 5; use Test::Builder; use Test::Builder::Tester; @@ -40,6 +40,7 @@ sub foobar_ok ($;$) { }; } { + test_out(" # Subtest: namehere"); test_out(" 1..2"); test_out(" ok 1 - foo"); test_out(" not ok 2 - bar"); @@ -64,6 +65,7 @@ sub foobar_ok_2 ($;$) { foobar_ok($value, $name); } { + test_out(" # Subtest: namehere"); test_out(" 1..2"); test_out(" ok 1 - foo"); test_out(" not ok 2 - bar"); @@ -93,6 +95,7 @@ sub barfoo_ok ($;$) { }); } { + test_out(" # Subtest: namehere"); test_out(" 1..2"); test_out(" ok 1 - foo"); test_out(" not ok 2 - bar"); @@ -117,6 +120,7 @@ sub barfoo_ok_2 ($;$) { barfoo_ok($value, $name); } { + test_out(" # Subtest: namehere"); test_out(" 1..2"); test_out(" ok 1 - foo"); test_out(" not ok 2 - bar"); @@ -134,8 +138,10 @@ sub barfoo_ok_2 ($;$) { # 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"); @@ -145,6 +151,7 @@ sub barfoo_ok_2 ($;$) { 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}."); @@ -154,5 +161,6 @@ sub barfoo_ok_2 ($;$) { 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"); +} diff --git a/cpan/Test-Simple/t/subtest/threads.t b/cpan/Test-Simple/t/subtest/threads.t new file mode 100644 index 0000000000..0d70b1e6e5 --- /dev/null +++ b/cpan/Test-Simple/t/subtest/threads.t @@ -0,0 +1,25 @@ +#!/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); diff --git a/cpan/Test-Simple/t/subtest/todo.t b/cpan/Test-Simple/t/subtest/todo.t index 345f5e124b..7269da9b95 100644 --- a/cpan/Test-Simple/t/subtest/todo.t +++ b/cpan/Test-Simple/t/subtest/todo.t @@ -52,6 +52,7 @@ sub test_subtest_in_todo { my ($set_via, $todo_reason, $level) = @$combo; test_out( + " # Subtest: xxx", @outlines, "not ok 1 - $xxx # TODO $todo_reason", "# Failed (TODO) test '$xxx'", diff --git a/cpan/Test-Simple/t/undef.t b/cpan/Test-Simple/t/undef.t index 26c10a94ec..2c8cace491 100644 --- a/cpan/Test-Simple/t/undef.t +++ b/cpan/Test-Simple/t/undef.t @@ -52,7 +52,7 @@ Test::More->builder->isnt_num(23, undef, 'isnt_num()'); #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; diff --git a/cpan/Test-Simple/t/use_ok.t b/cpan/Test-Simple/t/use_ok.t index 16e83122a6..9e858bc75e 100644 --- a/cpan/Test-Simple/t/use_ok.t +++ b/cpan/Test-Simple/t/use_ok.t @@ -1,38 +1,34 @@ #!/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)); @@ -40,16 +36,19 @@ use Test::More tests => 15; ::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 { @@ -59,9 +58,46 @@ use Test::More tests => 15; ::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; |