diff options
| -rw-r--r-- | embed.h | 1 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | objXSUB.h | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 71 | ||||
| -rw-r--r-- | proto.h | 1 |
5 files changed, 47 insertions, 29 deletions
@@ -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 @@ -258,6 +258,7 @@ my @staticfuncs = qw( dopoptoloop dopoptosub dopoptosub_at + free_closures save_lines doeval doopen_pmc @@ -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 @@ -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); @@ -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)); |