don't use PerlHost's getenv after perl_destruct

On Win32, perl_free calls PerlHost's getenv which calls win32_getenv.
win32_getenv and its children use SVs and mortal stack. After
perl_destruct SVs and mortal stack don't exist but the old Itmps_stack
pointer remains unchanged/un-nulled. Depending on the memory allocator
randomness, previous mortaled SV would be written to allocator freed
but page allocated memory and it silently worked. Recently in 5.17 the
page started to be freed and now this bug segvs. This patch fixes
the problem by using PL_perl_destruct_level and calling getenv earlier.

diff --git a/perl.c b/perl.c
index 84c901f..982b430 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -522,13 +522,18 @@ perl_destruct(pTHXx)
     PERL_WAIT_FOR_CHILDREN;
 
     destruct_level = PL_perl_destruct_level;
-#ifdef DEBUGGING
+#if defined(DEBUGGING) || defined(PERL_TRACK_MEMPOOL)
     {
        const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
        if (s) {
-            const int i = atoi(s);
-           if (destruct_level < i)
-               destruct_level = i;
+        const int i = atoi(s);
+#ifdef DEBUGGING
+           if (destruct_level < i) destruct_level = i;
+#endif
+#ifdef PERL_TRACK_MEMPOOL
+        /* RT #114496, for perl_free */
+        PL_perl_destruct_level = i;
+#endif
        }
     }
 #endif
@@ -1294,8 +1299,7 @@ perl_free(pTHXx)
         * Don't free thread memory if PERL_DESTRUCT_LEVEL is set to a non-zero
         * value as we're probably hunting memory leaks then
         */
-       const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
-       if (!s || atoi(s) == 0) {
+       if (PL_perl_destruct_level == 0) {
            const U32 old_debug = PL_debug;
            /* Emulate the PerlHost behaviour of free()ing all memory allocated in this
               thread at thread exit.  */