Skip to content

Commit

Permalink
Fix subtests when threads are on.
Browse files Browse the repository at this point in the history
The shared nature of a scalar value, in this case $self->{Curr_Test} is lost across
a simple hash copy as subtest() was doing.  So we reshare them on copy.

For #145

Signed-off-by: Michael G. Schwern <schwern@pobox.com>
  • Loading branch information
schwern committed Oct 18, 2011
1 parent 55b10d6 commit 1498d66
Show file tree
Hide file tree
Showing 3 changed files with 61 additions and 6 deletions.
1 change: 1 addition & 0 deletions Changes
@@ -1,6 +1,7 @@
0.98_01
Bug Fixes
* BAIL_OUT works inside a subtest. (Larry Leszczynski) [github #138]
* subtests now work with threads turned on. [github #145]


0.98 Wed, 23 Feb 2011 14:38:02 +1100
Expand Down
41 changes: 35 additions & 6 deletions lib/Test/Builder.pm
Expand Up @@ -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);
Expand Down Expand Up @@ -225,15 +239,17 @@ 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;

$child = $self->child($name);
%parent = %$self;
%$self = %$child;
_copy($self, $parent);
_copy($child, $self);

my $run_the_subtests = sub {
$subtests->();
Expand All @@ -247,8 +263,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});
Expand Down Expand Up @@ -426,7 +442,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( [] );

Expand All @@ -445,11 +460,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
Expand Down
25 changes: 25 additions & 0 deletions 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);

0 comments on commit 1498d66

Please sign in to comment.