From: Vincent Pit <vince@profvince.com>
Date: Thu, 4 Jun 2009 21:30:13 +0000 (+0200)
Subject: Don't exit() when dieing during cleanup
X-Git-Tag: v0.02~1
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=f178c1e569b78464ea63bf184389cf1b00804690;p=perl%2Fmodules%2FThread-Cleanup.git

Don't exit() when dieing during cleanup
---

diff --git a/Cleanup.xs b/Cleanup.xs
index 83ec8b4..cc55d59 100644
--- a/Cleanup.xs
+++ b/Cleanup.xs
@@ -31,7 +31,7 @@ STATIC void tc_callback(pTHX_ void *ud) {
   PUSHMARK(SP);
   PUTBACK;
 
-  call_pv(__PACKAGE__ "::_CLEANUP", G_VOID);
+  call_pv(__PACKAGE__ "::_CLEANUP", G_VOID | G_EVAL);
 
   PUTBACK;
 
diff --git a/MANIFEST b/MANIFEST
index 3667287..fed10b4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -9,6 +9,7 @@ t/00-load.t
 t/10-join.t
 t/11-detach.t
 t/20-recurse.t
+t/21-ctl.t
 t/91-pod.t
 t/92-pod-coverage.t
 t/95-portability-files.t
diff --git a/t/21-ctl.t b/t/21-ctl.t
new file mode 100644
index 0000000..4029b90
--- /dev/null
+++ b/t/21-ctl.t
@@ -0,0 +1,58 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Config qw/%Config/;
+
+BEGIN {
+ if (!$Config{useithreads}) {
+  require Test::More;
+  Test::More->import;
+  plan(skip_all => 'This perl wasn\'t built to support threads');
+ }
+}
+
+use threads;
+use threads::shared;
+
+use Test::More tests => 5 + 1;
+
+BEGIN {
+ defined and diag "Using threads $_"         for $threads::VERSION;
+ defined and diag "Using threads::shared $_" for $threads::shared::VERSION;
+}
+
+use Thread::Cleanup;
+
+my @stack : shared;
+
+sub msg { lock @stack; push @stack, join ':', @_ }
+
+Thread::Cleanup::register {
+ msg 'cleanup';
+ die 'cleanup';
+ msg 'not reached 1';
+};
+
+{
+ local $SIG{__DIE__} = sub { msg 'sig', @_ };
+ no warnings 'threads';
+ threads->create(sub {
+  msg 'spawn';
+  die 'thread';
+  msg 'not reached 2';
+ })->join;
+}
+
+msg 'done';
+
+{
+ lock @stack;
+ is   shift(@stack), 'spawn';
+ like shift(@stack), qr/sig:thread at \Q$0\E line \d+/;
+ is   shift(@stack), 'cleanup';
+ like shift(@stack), qr/sig:cleanup at \Q$0\E line \d+/;
+ is   shift(@stack), 'done';
+ is_deeply \@stack,  [ ], 'nothing more';
+}