From: Graham Knop <haarg@haarg.org>
Date: Fri, 16 Aug 2013 06:08:22 +0000 (-0400)
Subject: work around perl bug where pads may be reused in cleanup after fork
X-Git-Tag: Try-Tiny-0.17~2^2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=130617d97f55da4f25b48c850ca41b10c4581200;p=p5sagit%2FTry-Tiny.git

work around perl bug where pads may be reused in cleanup after fork

During global destruction triggered by a explicit exit after forking,
perl may re-use the pad for try in a nested call in a DESTROY.  All
variables used must be explictly initialized to avoid this.
---

diff --git a/lib/Try/Tiny.pm b/lib/Try/Tiny.pm
index 134ad81..f97e9f7 100644
--- a/lib/Try/Tiny.pm
+++ b/lib/Try/Tiny.pm
@@ -24,7 +24,9 @@ sub try (&;@) {
   # to $failed
   my $wantarray = wantarray;
 
-  my ( $catch, @finally );
+  # work around perl bug by explicitly initializing these, due to the likelyhood
+  # this will be used in global destruction (perl rt#119311)
+  my ( $catch, @finally ) = ();
 
   # find labeled blocks in the argument list.
   # catch and finally tag the blocks by blessing a scalar reference to them.
diff --git a/t/global_destruction_forked.t b/t/global_destruction_forked.t
new file mode 100644
index 0000000..a9c306f
--- /dev/null
+++ b/t/global_destruction_forked.t
@@ -0,0 +1,57 @@
+use strict;
+use warnings;
+use Test::More;
+use Try::Tiny;
+
+{
+  package WithCatch;
+  use Try::Tiny;
+
+  sub DESTROY {
+    try {}
+    catch {};
+    return;
+  }
+}
+
+{
+  package WithFinally;
+  use Try::Tiny;
+
+  sub DESTROY {
+    try {}
+    finally {};
+    return;
+  }
+}
+
+my $parent = $$;
+
+try {
+  my $pid = fork;
+  unless ($pid) {
+    my $o = bless {}, 'WithCatch';
+    $SIG{__DIE__} = sub {
+      exit 1
+        if $_[0] =~ /A try\(\) may not be followed by multiple catch\(\) blocks/;
+      exit 2;
+    };
+    exit 0;
+  }
+  waitpid $pid, 0;
+  is $?, 0, 'nested try in cleanup after fork does not maintain outer catch block';
+}
+catch {};
+
+try {
+  my $pid = fork;
+  unless ($pid) {
+    my $o = bless {}, 'WithFinally';
+    exit 0;
+  }
+  waitpid $pid, 0;
+  is $?, 0, 'nested try in cleanup after fork does not maintain outer finally block';
+}
+finally { exit 1 if $parent != $$ };
+
+done_testing;