summaryrefslogtreecommitdiff
path: root/cpan/Test-Simple/lib/Test/Builder.pm
diff options
context:
space:
mode:
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>2010-08-14 15:06:07 +0100
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>2010-08-14 17:49:01 +0100
commit809046db05742711d28ee1fbb0a0e63a4e73ed89 (patch)
treee34d9a7114c08283726d213210a6e06484ab2dc4 /cpan/Test-Simple/lib/Test/Builder.pm
parentbc337e5c08fd3b2fb5063efa582bb40d199419b1 (diff)
downloadperl-809046db05742711d28ee1fbb0a0e63a4e73ed89.tar.gz
Update Test-Simple to CPAN version 0.96
[DELTA] 0.96 Tue Aug 10 21:13:04 PDT 2010 Bug Fixes * You can call done_testing() again after reset() [googlecode 59] Other * Bug tracker moved to github 0.95_02 Wed May 19 15:46:52 PDT 2010 Bug Fixes * Correct various typos and spelling errors (Nick Cleaton) * Fix alignment of indented multi-line diagnostics from subtests (Nick Cleaton) * Fix incorrect operation when subtest called from within a todo block (Nick Cleaton) * Avoid spurious output after a fork within a subtest (Nick Cleaton) 0.95_01 Wed Mar 3 15:36:59 PST 2010 Bug Fixes * is_deeply() didn't see a difference in regexes [rt.cpan.org 53469] * Test::Builder::Tester now sets $tb->todo_output to the output handle and not the error handle (to be in accordance with the default behaviour of Test::Builder and allow for testing TODO test behaviour). * Fixed file/line in failing subtest() diagnostics. (Nick Cleaton) * Protect against subtests setting $Level (Nick Cleaton) New Features * subtests without a 'plan' or 'no_plan' have an implicit 'done_testing()' added to them. * is_deeply() performance boost for large structures consisting of mostly non-refs (Nick Cleaton) Feature Changes * is() and others will no longer stringify its arguments before comparing. Overloaded objects will make use of their eq overload rather than their "" overload. This can break tests of impolitely string overloaded objects. DateTime prior to 0.54 is the biggest example.
Diffstat (limited to 'cpan/Test-Simple/lib/Test/Builder.pm')
-rw-r--r--cpan/Test-Simple/lib/Test/Builder.pm110
1 files changed, 86 insertions, 24 deletions
diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm
index 26ffea41ff..52b32a1d9b 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.94';
+our $VERSION = '0.96';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
BEGIN {
@@ -23,7 +23,7 @@ BEGIN {
require threads::shared;
# Hack around YET ANOTHER threads::shared bug. It would
- # occassionally forget the contents of the variable when sharing it.
+ # occasionally forget the contents of the variable when sharing it.
# So we first copy the data, then share, then put our copy back.
*share = sub (\[$@%]) {
my $type = ref $_[0];
@@ -90,7 +90,7 @@ Test::Builder - Backend for building test libraries
=head1 DESCRIPTION
Test::Simple and Test::More have proven to be popular testing modules,
-but they're not always flexible enough. Test::Builder provides the a
+but they're not always flexible enough. Test::Builder provides a
building block upon which to write your own test libraries I<which can
work together>.
@@ -156,7 +156,7 @@ sub create {
$child->finalize;
Returns a new instance of C<Test::Builder>. Any output from this child will
-indented four spaces more than the parent's indentation. When done, the
+be indented four spaces more than the parent's indentation. When done, the
C<finalize> method I<must> be called explicitly.
Trying to create a new child with a previous child still active (i.e.,
@@ -174,18 +174,28 @@ sub child {
$self->croak("You already have a child named ($self->{Child_Name}) running");
}
+ my $parent_in_todo = $self->in_todo;
+
+ # Clear $TODO for the child.
+ my $orig_TODO = $self->find_TODO(undef, 1, undef);
+
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};
+ if ($parent_in_todo) {
+ $child->{Fail_FH} = $self->{Todo_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->{Parent_TODO} = $orig_TODO;
$child->{Name} = $name || "Child of " . $self->name;
$self->{Child_Name} = $child->name;
return $child;
@@ -210,25 +220,71 @@ 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 $child = $self->child($name);
- my %parent = %$self;
- %$self = %$child;
+ my($error, $child, %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;
- my $error;
- if( !eval { $subtests->(); 1 } ) {
- $error = $@;
+ $child = $self->child($name);
+ %parent = %$self;
+ %$self = %$child;
+
+ my $run_the_subtests = sub {
+ $subtests->();
+ $self->done_testing unless $self->_plan_handled;
+ 1;
+ };
+
+ if( !eval { $run_the_subtests->() } ) {
+ $error = $@;
+ }
}
# Restore the parent and the copied child.
%$child = %$self;
%$self = %parent;
+ # Restore the parent's $TODO
+ $self->find_TODO(undef, 1, $child->{Parent_TODO});
+
# Die *after* we restore the parent.
die $error if $error and !eval { $error->isa('Test::Builder::Exception') };
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
return $child->finalize;
}
+=begin _private
+
+=item B<_plan_handled>
+
+ if ( $Test->_plan_handled ) { ... }
+
+Returns true if the developer has explicitly handled the plan via:
+
+=over 4
+
+=item * Explicitly setting the number of tests
+
+=item * Setting 'no_plan'
+
+=item * Set 'skip_all'.
+
+=back
+
+This is currently used in subtests when we implicitly call C<< $Test->done_testing >>
+if the developer has not set a plan.
+
+=end _private
+
+=cut
+
+sub _plan_handled {
+ my $self = shift;
+ return $self->{Have_Plan} || $self->{No_Plan} || $self->{Skip_All};
+}
+
=item B<finalize>
@@ -261,6 +317,7 @@ sub finalize {
# XXX This will only be necessary for TAP envelopes (we think)
#$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" );
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ok = 1;
$self->parent->{Child_Name} = undef;
if ( $self->{Skip_All} ) {
@@ -315,7 +372,7 @@ sub name { shift->{Name} }
sub DESTROY {
my $self = shift;
- if ( $self->parent ) {
+ if ( $self->parent and $$ == $self->{Original_Pid} ) {
my $name = $self->name;
$self->diag(<<"FAIL");
Child ($name) exited without calling finalize()
@@ -350,6 +407,7 @@ sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
$self->{Have_Plan} = 0;
$self->{No_Plan} = 0;
$self->{Have_Output_Plan} = 0;
+ $self->{Done_Testing} = 0;
$self->{Original_Pid} = $$;
$self->{Child_Name} = undef;
@@ -458,7 +516,6 @@ sub _plan_tests {
return;
}
-
=item B<expected_tests>
my $max = $Test->expected_tests;
@@ -504,7 +561,6 @@ sub no_plan {
return 1;
}
-
=begin private
=item B<_output_plan>
@@ -543,6 +599,7 @@ sub _output_plan {
return;
}
+
=item B<done_testing>
$Test->done_testing();
@@ -879,8 +936,6 @@ sub is_eq {
my( $self, $got, $expect, $name ) = @_;
local $Level = $Level + 1;
- $self->_unoverload_str( \$got, \$expect );
-
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
@@ -897,8 +952,6 @@ sub is_num {
my( $self, $got, $expect, $name ) = @_;
local $Level = $Level + 1;
- $self->_unoverload_num( \$got, \$expect );
-
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
@@ -1059,8 +1112,9 @@ sub cmp_ok {
my($pack, $file, $line) = $self->caller();
+ # This is so that warnings come out at the caller's level
$test = eval qq[
-#line 1 "cmp_ok [from $file line $line]"
+#line $line "(eval in cmp_ok) $file"
\$got $type \$expect;
];
$error = $@;
@@ -1685,17 +1739,18 @@ sub _print_to_fh {
return if $^C;
my $msg = join '', @msgs;
+ my $indent = $self->_indent;
local( $\, $", $, ) = ( undef, ' ', '' );
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
- $msg =~ s{\n(?!\z)}{\n# }sg;
+ $msg =~ s{\n(?!\z)}{\n$indent# }sg;
# Stick a newline on the end if it needs it.
$msg .= "\n" unless $msg =~ /\n\z/;
- return print $fh $self->_indent, $msg;
+ return print $fh $indent, $msg;
}
=item B<output>
@@ -2091,21 +2146,28 @@ sub todo {
=item B<find_TODO>
my $todo_reason = $Test->find_TODO();
- my $todo_reason = $Test->find_TODO($pack):
+ my $todo_reason = $Test->find_TODO($pack);
Like C<todo()> but only returns the value of C<$TODO> ignoring
C<todo_start()>.
+Can also be used to set C<$TODO> to a new value while returning the
+old value:
+
+ my $old_reason = $Test->find_TODO($pack, 1, $new_reason);
+
=cut
sub find_TODO {
- my( $self, $pack ) = @_;
+ my( $self, $pack, $set, $new_value ) = @_;
$pack = $pack || $self->caller(1) || $self->exported_to;
return unless $pack;
no strict 'refs'; ## no critic
- return ${ $pack . '::TODO' };
+ my $old_value = ${ $pack . '::TODO' };
+ $set and ${ $pack . '::TODO' } = $new_value;
+ return $old_value;
}
=item B<in_todo>
@@ -2458,7 +2520,7 @@ Test::Builder.
=head1 MEMORY
-An informative hash, accessable via C<<details()>>, is stored for each
+An informative hash, accessible via C<<details()>>, is stored for each
test you perform. So memory usage will scale linearly with each test
run. Although this is not a problem for most test suites, it can
become an issue if you do large (hundred thousands to million)