fix memory leak on Windows (PL_sys_intern contents were never

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

diff --git a/perl.c b/perl.c
index 1cc1a87..9736d3b 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -600,9 +600,14 @@ perl_destruct(pTHXx)
     if (!specialWARN(PL_compiling.cop_warnings))
        SvREFCNT_dec(PL_compiling.cop_warnings);
     PL_compiling.cop_warnings = Nullsv;
-#ifndef USE_ITHREADS
+#ifdef USE_ITHREADS
+    Safefree(CopFILE(&PL_compiling));
+    CopFILE(&PL_compiling) = Nullch;
+    Safefree(CopSTASHPV(&PL_compiling));
+#else
     SvREFCNT_dec(CopFILEGV(&PL_compiling));
-    CopFILEGV_set(&PL_compiling, Nullgv);
+    CopFILEGV(&PL_compiling) = Nullgv;
+    /* cop_stash is not refcounted */
 #endif
 
     /* Prepare to destruct main symbol table.  */
@@ -652,6 +657,10 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_fdpid);            /* needed in io_close() */
     PL_fdpid = Nullav;
 
+#ifdef HAVE_INTERP_INTERN
+    sys_intern_clear();
+#endif
+
     /* Destruct the global string table. */
     {
        /* Yell and reset the HeVAL() slots that are still holding refcounts,
@@ -701,9 +710,6 @@ perl_destruct(pTHXx)
     if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
        Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
 
-    sv_free_arenas();
-
-    /* No SVs have survived, need to clean out */
     Safefree(PL_origfilename);
     Safefree(PL_reg_start_tmp);
     if (PL_reg_curpm)
@@ -711,6 +717,8 @@ perl_destruct(pTHXx)
     Safefree(PL_reg_poscache);
     Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh));
     Safefree(PL_op_mask);
+    Safefree(PL_psig_ptr);
+    Safefree(PL_psig_name);
     nuke_stacks();
     PL_hints = 0;              /* Reset hints. Should hints be per-interpreter ? */
     
@@ -732,6 +740,8 @@ perl_destruct(pTHXx)
     PL_thrsv = Nullsv;
 #endif /* USE_THREADS */
 
+    sv_free_arenas();
+
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (PL_mess_sv) {
@@ -1609,7 +1619,6 @@ L<perlcall>.
 
 I32
 Perl_call_sv(pTHX_ SV *sv, I32 flags)
-       
                        /* See G_* flags in cop.h */
 {
     dSP;
@@ -1667,7 +1676,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
        CATCH_SET(oldcatch);
     }
     else {
-       cLOGOP->op_other = PL_op;
+       myop.op_other = (OP*)&myop;
        PL_markstack_ptr--;
        /* we're trying to emulate pp_entertry() here */
        {
@@ -1780,9 +1789,9 @@ S_call_body(pTHX_ OP *myop, int is_eval)
 
     if (PL_op == myop) {
        if (is_eval)
-           PL_op = Perl_pp_entereval(aTHX);
+           PL_op = Perl_pp_entereval(aTHX);    /* this doesn't do a POPMARK */
        else
-           PL_op = Perl_pp_entersub(aTHX);
+           PL_op = Perl_pp_entersub(aTHX);     /* this does */
     }
     if (PL_op)
        CALLRUNOPS(aTHX);
@@ -1904,7 +1913,6 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
     dSP;
     SV* sv = newSVpv(p, 0);
 
-    PUSHMARK(SP);
     eval_sv(sv, G_SCALAR);
     SvREFCNT_dec(sv);
 
@@ -2512,6 +2520,11 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
        }
     }
 
+#ifdef USE_ITHREADS
+    Safefree(CopFILE(PL_curcop));
+#else
+    SvREFCNT_dec(CopFILEGV(PL_curcop));
+#endif
     CopFILE_set(PL_curcop, PL_origfilename);
     if (strEQ(PL_origfilename,"-"))
        scriptname = "";