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

p4raw-id: //depot/perl@3511

5 files changed, 47 insertions, 29 deletions

diff --git a/embed.h b/embed.h
index e413efc90c..aa9db44716 100644
--- 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 028e217771..381c040cb6 100755
--- 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 658e5ce226..d37a925037 100644
--- 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 a4c0247168..9e78a31f4a 100644
--- 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 6ec5b378d4..89c70fc826 100644
--- 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));