From: Dave Mitchell <davem@fdisolutions.com>
Date: Mon, 15 Jan 2007 14:16:53 +0000 (+0000)
Subject: extend threads 'veto cleanup' to perl_free and system stuff
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c301d6064f299b8a77670348b81d25d2d94d6a2f;p=p5sagit%2Fp5-mst-13.2.git

extend threads 'veto cleanup' to perl_free and system stuff

p4raw-id: //depot/perl@29827
---

diff --git a/embedvar.h b/embedvar.h
index 566c2ff..0898cf6 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -800,6 +800,8 @@
 #define PL_Gtimesbase		(my_vars->Gtimesbase)
 #define PL_use_safe_putenv	(my_vars->Guse_safe_putenv)
 #define PL_Guse_safe_putenv	(my_vars->Guse_safe_putenv)
+#define PL_veto_cleanup		(my_vars->Gveto_cleanup)
+#define PL_Gveto_cleanup	(my_vars->Gveto_cleanup)
 #define PL_watch_pvx		(my_vars->Gwatch_pvx)
 #define PL_Gwatch_pvx		(my_vars->Gwatch_pvx)
 
@@ -840,6 +842,7 @@
 #define PL_Gthr_key		PL_thr_key
 #define PL_Gtimesbase		PL_timesbase
 #define PL_Guse_safe_putenv	PL_use_safe_putenv
+#define PL_Gveto_cleanup	PL_veto_cleanup
 #define PL_Gwatch_pvx		PL_watch_pvx
 
 #endif /* PERL_GLOBAL_STRUCT */
diff --git a/perl.c b/perl.c
index f9cebf1..fdcbcbd 100644
--- a/perl.c
+++ b/perl.c
@@ -580,6 +580,7 @@ perl_destruct(pTHXx)
 
     if (CALL_FPTR(PL_threadhook)(aTHX)) {
         /* Threads hook has vetoed further cleanup */
+	PL_veto_cleanup = TRUE;
         return STATUS_EXIT;
     }
 
@@ -1325,6 +1326,9 @@ Releases a Perl interpreter.  See L<perlembed>.
 void
 perl_free(pTHXx)
 {
+    if (PL_veto_cleanup)
+	return;
+
 #ifdef PERL_TRACK_MEMPOOL
     {
 	/*
@@ -1381,7 +1385,7 @@ __attribute__((destructor))
 perl_fini(void)
 {
     dVAR;
-    if (PL_curinterp)
+    if (PL_curinterp  && !PL_veto_cleanup)
 	FREE_THREAD_KEY;
 }
 
diff --git a/perlapi.h b/perlapi.h
index 3189d1f..38ebafb 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -864,6 +864,8 @@ END_EXTERN_C
 #define PL_timesbase		(*Perl_Gtimesbase_ptr(NULL))
 #undef  PL_use_safe_putenv
 #define PL_use_safe_putenv	(*Perl_Guse_safe_putenv_ptr(NULL))
+#undef  PL_veto_cleanup
+#define PL_veto_cleanup		(*Perl_Gveto_cleanup_ptr(NULL))
 #undef  PL_watch_pvx
 #define PL_watch_pvx		(*Perl_Gwatch_pvx_ptr(NULL))
 
diff --git a/perlvars.h b/perlvars.h
index 94792fe..4970146 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -146,3 +146,8 @@ PERLVAR(Ghints_mutex, perl_mutex)    /* Mutex for refcounted he refcounting */
 #if defined(USE_ITHREADS)
 PERLVAR(Gperlio_mutex, perl_mutex)    /* Mutex for perlio fd refcounts */
 #endif
+
+/* this is currently set without MUTEX protection, so keep it a type which
+ * can be set atomically (ie not a bit field) */
+PERLVARI(Gveto_cleanup,	int, FALSE)	/* exit without cleanup */
+
diff --git a/unixish.h b/unixish.h
index 279084c..5f95ba5 100644
--- a/unixish.h
+++ b/unixish.h
@@ -132,7 +132,11 @@
 #endif
 
 #ifndef PERL_SYS_TERM
-#  define PERL_SYS_TERM()		HINTS_REFCNT_TERM; OP_REFCNT_TERM; PERLIO_TERM; MALLOC_TERM
+#  define PERL_SYS_TERM() \
+    if (!PL_veto_cleanup) { \
+	HINTS_REFCNT_TERM; OP_REFCNT_TERM; PERLIO_TERM; MALLOC_TERM; \
+    }
+
 #endif
 
 #define BIT_BUCKET "/dev/null"