From 1498d66c355d625175fb671e7b9b5b7b69662504 Mon Sep 17 00:00:00 2001
From: "Michael G. Schwern" <schwern@pobox.com>
Date: Mon, 17 Oct 2011 18:04:59 -0700
Subject: [PATCH] Fix subtests when threads are on.

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>
---
 Changes             |  1 +
 lib/Test/Builder.pm | 41 +++++++++++++++++++++++++++++++++++------
 t/subtest/threads.t | 25 +++++++++++++++++++++++++
 3 files changed, 61 insertions(+), 6 deletions(-)
 create mode 100644 t/subtest/threads.t

diff --git a/Changes b/Changes
index 4b1b510c9..a212d4815 100644
--- a/Changes
+++ b/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
diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm
index 07f943e01..c1c55ee1f 100644
--- a/lib/Test/Builder.pm
+++ b/lib/Test/Builder.pm
@@ -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);
@@ -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->();
@@ -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});
@@ -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( [] );
 
@@ -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
diff --git a/t/subtest/threads.t b/t/subtest/threads.t
new file mode 100644
index 000000000..0d70b1e6e
--- /dev/null
+++ b/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);