diff options
| -rw-r--r-- | embedvar.h | 3 | ||||
| -rw-r--r-- | perl.c | 6 | ||||
| -rw-r--r-- | perlapi.h | 2 | ||||
| -rw-r--r-- | perlvars.h | 5 | ||||
| -rw-r--r-- | unixish.h | 6 |
5 files changed, 20 insertions, 2 deletions
diff --git a/embedvar.h b/embedvar.h index 566c2ff196..0898cf682d 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 */ @@ -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; } @@ -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 94792fe0da..4970146b07 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 */ + @@ -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" |