fix memory leak in C<eval 'return sub {...}'>

p4raw-id: //depot/perl@3511

diff --git a/embed.h b/embed.h
index e413efc..aa9db44 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1179,6 +1179,7 @@
 #define force_word             CPerlObj::Perl_force_word
 #define form                   CPerlObj::Perl_form
 #define fprintf                        CPerlObj::Perl_fprintf
+#define free_closures          CPerlObj::Perl_free_closures
 #define free_tmps              CPerlObj::Perl_free_tmps
 #define gen_constant_list      CPerlObj::Perl_gen_constant_list
 #define get_db_sub             CPerlObj::Perl_get_db_sub

diff --git a/embed.pl b/embed.pl
index 028e217..381c040 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -258,6 +258,7 @@ my @staticfuncs = qw(
     dopoptoloop
     dopoptosub
     dopoptosub_at
+    free_closures
     save_lines
     doeval
     doopen_pmc

diff --git a/objXSUB.h b/objXSUB.h
index 658e5ce..d37a925 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1221,6 +1221,8 @@
 #define form                   pPerl->Perl_form
 #undef  fprintf
 #define fprintf                        pPerl->Perl_fprintf
+#undef  free_closures
+#define free_closures          pPerl->Perl_free_closures
 #undef  free_tmps
 #define free_tmps              pPerl->Perl_free_tmps
 #undef  gen_constant_list

diff --git a/pp_ctl.c b/pp_ctl.c
index a4c0247..9e78a31 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -49,6 +49,7 @@ static I32 amagic_ncmp _((SV *a, SV *b));
 static I32 amagic_i_ncmp _((SV *a, SV *b));
 static I32 amagic_cmp _((SV *str1, SV *str2));
 static I32 amagic_cmp_locale _((SV *str1, SV *str2));
+static void free_closures _((void));
 #endif
 
 PP(pp_wantarray)
@@ -1324,6 +1325,42 @@ dounwind(I32 cxix)
     }
 }
 
+/*
+ * Closures mentioned at top level of eval cannot be referenced
+ * again, and their presence indirectly causes a memory leak.
+ * (Note that the fact that compcv and friends are still set here
+ * is, AFAIK, an accident.)  --Chip
+ *
+ * XXX need to get comppad et al from eval's cv rather than
+ * relying on the incidental global values.
+ */
+STATIC void
+free_closures(void)
+{
+    dTHR;
+    SV **svp = AvARRAY(PL_comppad_name);
+    I32 ix;
+    for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) {
+       SV *sv = svp[ix];
+       if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') {
+           SvREFCNT_dec(sv);
+           svp[ix] = &PL_sv_undef;
+
+           sv = PL_curpad[ix];
+           if (CvCLONE(sv)) {
+               SvREFCNT_dec(CvOUTSIDE(sv));
+               CvOUTSIDE(sv) = Nullcv;
+           }
+           else {
+               SvREFCNT_dec(sv);
+               sv = NEWSV(0,0);
+               SvPADTMP_on(sv);
+               PL_curpad[ix] = sv;
+           }
+       }
+    }
+}
+
 OP *
 die_where(char *message, STRLEN msglen)
 {
@@ -1804,6 +1841,9 @@ PP(pp_return)
        break;
     case CXt_EVAL:
        POPEVAL(cx);
+       if (AvFILLp(PL_comppad_name) >= 0)
+           free_closures();
+       lex_end();
        if (optype == OP_REQUIRE &&
            (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
        {
@@ -3083,35 +3123,8 @@ PP(pp_leaveeval)
     }
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
-    /*
-     * Closures mentioned at top level of eval cannot be referenced
-     * again, and their presence indirectly causes a memory leak.
-     * (Note that the fact that compcv and friends are still set here
-     * is, AFAIK, an accident.)  --Chip
-     */
-    if (AvFILLp(PL_comppad_name) >= 0) {
-       SV **svp = AvARRAY(PL_comppad_name);
-       I32 ix;
-       for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) {
-           SV *sv = svp[ix];
-           if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') {
-               SvREFCNT_dec(sv);
-               svp[ix] = &PL_sv_undef;
-
-               sv = PL_curpad[ix];
-               if (CvCLONE(sv)) {
-                   SvREFCNT_dec(CvOUTSIDE(sv));
-                   CvOUTSIDE(sv) = Nullcv;
-               }
-               else {
-                   SvREFCNT_dec(sv);
-                   sv = NEWSV(0,0);
-                   SvPADTMP_on(sv);
-                   PL_curpad[ix] = sv;
-               }
-           }
-       }
-    }
+    if (AvFILLp(PL_comppad_name) >= 0)
+       free_closures();
 
 #ifdef DEBUGGING
     assert(CvDEPTH(PL_compcv) == 1);

diff --git a/proto.h b/proto.h
index 6ec5b37..89c70fc 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -760,6 +760,7 @@ I32 dopoptolabel _((char *label));
 I32 dopoptoloop _((I32 startingblock));
 I32 dopoptosub _((I32 startingblock));
 I32 dopoptosub_at _((PERL_CONTEXT* cxstk, I32 startingblock));
+void free_closures _((void));
 void save_lines _((AV *array, SV *sv));
 OP *doeval _((int gimme, OP** startop));
 PerlIO *doopen_pmc _((const char *name, const char *mode));