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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"