From: Graham Knop <haarg@haarg.org>
Date: Mon, 22 Jul 2013 19:44:05 +0000 (-0400)
Subject: add CLONE method to fix Sub::Defer/Quote in threads
X-Git-Tag: v1.003001~29
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=efdff87e4e45cee9e0b2bc5ac2d7659e8870c249;p=gitmo%2FMoo.git

add CLONE method to fix Sub::Defer/Quote in threads
---

diff --git a/lib/Sub/Defer.pm b/lib/Sub/Defer.pm
index d28daf2..236b4a9 100644
--- a/lib/Sub/Defer.pm
+++ b/lib/Sub/Defer.pm
@@ -41,16 +41,20 @@ sub defer_info {
 sub defer_sub {
   my ($target, $maker) = @_;
   my $undeferred;
-  my $deferred_string;
-  my $deferred = sub {
-    goto &{$undeferred ||= undefer_sub($deferred_string)};
+  my $deferred;
+  $deferred = sub {
+    $undeferred ||= undefer_sub($deferred);
+    goto &$undeferred;
   };
-  $deferred_string = "$deferred";
   $DEFERRED{$deferred} = [ $target, $maker, \$undeferred, $deferred ];
   _install_coderef($target => $deferred) if defined $target;
   return $deferred;
 }
 
+sub CLONE {
+  %DEFERRED = map { $_->[3] => $_ } values %DEFERRED;
+}
+
 1;
 
 =head1 NAME
diff --git a/lib/Sub/Quote.pm b/lib/Sub/Quote.pm
index 52aae7e..d9efa85 100644
--- a/lib/Sub/Quote.pm
+++ b/lib/Sub/Quote.pm
@@ -63,13 +63,12 @@ sub quote_sub {
   undef($captures) if $captures && !keys %$captures;
   my $code = pop;
   my $name = $_[0];
-  my $outstanding;
-  my $deferred = defer_sub +($options->{no_install} ? undef : $name) => sub {
-    unquote_sub($outstanding);
+  my $deferred;
+  $deferred = defer_sub +($options->{no_install} ? undef : $name) => sub {
+    unquote_sub($deferred);
   };
-  $outstanding = "$deferred";
-  $QUOTED{$outstanding} = [ $name, $code, $captures ];
-  weaken($WEAK_REFS{$outstanding} = $deferred);
+  $QUOTED{$deferred} = [ $name, $code, $captures ];
+  weaken($WEAK_REFS{$deferred} = $deferred);
   return $deferred;
 }
 
@@ -85,23 +84,22 @@ sub unquote_sub {
 
     my $make_sub = "{\n";
 
-    if (keys %$captures) {
-      $make_sub .= capture_unroll("\$_[1]", $captures, 2);
-    }
+    my %captures = $captures ? %$captures : ();
+    $captures{'$_QUOTED'} = \$QUOTED{$sub};
+    $make_sub .= capture_unroll("\$_[1]", \%captures, 2);
 
-    my $o_quoted = perlstring $sub;
     $make_sub .= (
       $name
           # disable the 'variable $x will not stay shared' warning since
           # we're not letting it escape from this scope anyway so there's
           # nothing trying to share it
         ? "  no warnings 'closure';\n  sub ${name} {\n"
-        : "  \$Sub::Quote::QUOTED{${o_quoted}}[3] = sub {\n"
+        : "  \$_QUOTED->[3] = sub {\n"
     );
     $make_sub .= $code;
     $make_sub .= "  }".($name ? '' : ';')."\n";
     if ($name) {
-      $make_sub .= "  \$Sub::Quote::QUOTED{${o_quoted}}[3] = \\&${name}\n";
+      $make_sub .= "  \$_QUOTED->[3] = \\&${name}\n";
     }
     $make_sub .= "}\n1;\n";
     $ENV{SUB_QUOTE_DEBUG} && warn $make_sub;
@@ -109,7 +107,7 @@ sub unquote_sub {
       local $@;
       no strict 'refs';
       local *{$name} if $name;
-      unless (_clean_eval $make_sub, $captures) {
+      unless (_clean_eval $make_sub, \%captures) {
         die "Eval went very, very wrong:\n\n${make_sub}\n\n$@";
       }
     }
@@ -117,6 +115,11 @@ sub unquote_sub {
   $QUOTED{$sub}[3];
 }
 
+sub CLONE {
+  %QUOTED = map { $WEAK_REFS{$_} => $QUOTED{$_} } keys %WEAK_REFS;
+  %WEAK_REFS = map { $_ => $_ } values %WEAK_REFS;
+}
+
 1;
 
 =head1 NAME