Patch for Perlbug #4253

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index 8accfb8..aad80ed 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -181,9 +181,6 @@ PerlInterpreter *
 perl_alloc(void)
 {
     PerlInterpreter *my_perl;
-#ifdef USE_5005THREADS
-    dTHX;
-#endif
 
     /* New() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
@@ -353,9 +350,6 @@ perl_destruct(pTHXx)
 {
     volatile int destruct_level;  /* 0=none, 1=full, 2=full with checks */
     HV *hv;
-#ifdef USE_5005THREADS
-    dTHX;
-#endif /* USE_5005THREADS */
 
     /* wait for all pseudo-forked children to finish */
     PERL_WAIT_FOR_CHILDREN;
@@ -947,6 +941,31 @@ perl_free(pTHXx)
 #endif
 }
 
+#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+/* provide destructors to clean up the thread key when libperl is unloaded */
+#ifndef WIN32 /* handled during DLL_PROCESS_DETACH in win32/perllib.c */
+
+#if defined(__hpux) && !defined(__GNUC__)
+#pragma fini "perl_fini"
+#endif
+
+#if defined(__GNUC__) && defined(__attribute__) 
+/* want to make sure __attribute__ works here even
+ * for -Dd_attribut=undef builds.
+ */
+#undef __attribute__
+#endif
+
+static void __attribute__((destructor))
+perl_fini()
+{
+    if (PL_curinterp)
+       FREE_THREAD_KEY;
+}
+
+#endif /* WIN32 */
+#endif /* THREADS */
+
 void
 Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
 {
@@ -1021,9 +1040,6 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
     I32 oldscope;
     int ret;
     dJMPENV;
-#ifdef USE_5005THREADS
-    dTHX;
-#endif
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef IAMSUID
@@ -1718,9 +1734,6 @@ perl_run(pTHXx)
     I32 oldscope;
     int ret = 0;
     dJMPENV;
-#ifdef USE_5005THREADS
-    dTHX;
-#endif
 
     oldscope = PL_scopestack_ix;
 #ifdef VMS
@@ -2707,13 +2720,13 @@ Perl_moreswitches(pTHX_ char *s)
                (void *)upg_version(PL_patchlevel);
 #if !defined(DGUX)
        PerlIO_printf(PerlIO_stdout(),
-               Perl_form(aTHX_ "\nThis is perl, v%_ built for %s",
+               Perl_form(aTHX_ "\nThis is perl, v%"SVf" built for %s",
                    vstringify(PL_patchlevel),
                    ARCHNAME));
 #else /* DGUX */
 /* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */
        PerlIO_printf(PerlIO_stdout(),
-               Perl_form(aTHX_ "\nThis is perl, v%_\n",
+               Perl_form(aTHX_ "\nThis is perl, v%"SVf"\n",
                    vstringify(PL_patchlevel)));
        PerlIO_printf(PerlIO_stdout(),
                        Perl_form(aTHX_ "        built under %s at %s %s\n",