In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ad0dc73b97f22a660d0022d35f64ccd4ff7bfde6?hp=a35cc1c13abf28a1d52012f7dd511e544902becf>
- Log ----------------------------------------------------------------- commit ad0dc73b97f22a660d0022d35f64ccd4ff7bfde6 Author: Father Chrysostomos <[email protected]> Date: Wed Sep 19 22:03:55 2012 -0700 op.c: Disentangle apply_attrs_my from apply_attrs apply_attrs consisted of a top-level if/else conditional upon a bool- ean argument. It was being called with a TRUE argument in only one place, apply_attrs_my. Inlining that branch into apply_attrs_my actu- ally reduces the amount of code slightly. M embed.fnc M embed.h M op.c M proto.h commit 9fa29fa7929b4167c5491b792c5cc7e4365a2839 Author: Father Chrysostomos <[email protected]> Date: Wed Sep 19 21:53:51 2012 -0700 [perl #114764] Stop my vars with attrs from leaking S_apply_attrs was creating a SV containing a stash name, that was later to be put in a const op, which would take care of freeing it. But it didnât free it for a my variable, because the branch where that const op was created didnât apply. So move the creation of that SV inside the branch that uses it, otherwise it leaks. This leak was the result of commit 95f0a2f1ffc6. M op.c M t/op/svleak.t ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 +- embed.h | 2 +- op.c | 36 ++++++++++++++++-------------------- proto.h | 2 +- t/op/svleak.t | 5 ++++- 5 files changed, 23 insertions(+), 24 deletions(-) diff --git a/embed.fnc b/embed.fnc index 8553fb8..8b03b25 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1759,7 +1759,7 @@ s |SV* |gv_ename |NN GV *gv sRn |bool |scalar_mod_type|NULLOK const OP *o|I32 type s |OP * |my_kid |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp s |OP * |dup_attrlist |NN OP *o -s |void |apply_attrs |NN HV *stash|NN SV *target|NULLOK OP *attrs|bool for_my +s |void |apply_attrs |NN HV *stash|NN SV *target|NULLOK OP *attrs s |void |apply_attrs_my |NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp s |void |bad_type_pv |I32 n|NN const char *t|NN const char *name|U32 flags|NN const OP *kid s |void |bad_type_sv |I32 n|NN const char *t|NN SV *namesv|U32 flags|NN const OP *kid diff --git a/embed.h b/embed.h index e0afb12..79e10a8 100644 --- a/embed.h +++ b/embed.h @@ -1387,7 +1387,7 @@ # endif # if defined(PERL_IN_OP_C) #define aassign_common_vars(a) S_aassign_common_vars(aTHX_ a) -#define apply_attrs(a,b,c,d) S_apply_attrs(aTHX_ a,b,c,d) +#define apply_attrs(a,b,c) S_apply_attrs(aTHX_ a,b,c) #define apply_attrs_my(a,b,c,d) S_apply_attrs_my(aTHX_ a,b,c,d) #define bad_type_pv(a,b,c,d,e) S_bad_type_pv(aTHX_ a,b,c,d,e) #define bad_type_sv(a,b,c,d,e) S_bad_type_sv(aTHX_ a,b,c,d,e) diff --git a/op.c b/op.c index 5d81504..1406ffc 100644 --- a/op.c +++ b/op.c @@ -2450,31 +2450,20 @@ S_dup_attrlist(pTHX_ OP *o) } STATIC void -S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) +S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs) { dVAR; - SV *stashsv; + SV * const stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no; PERL_ARGS_ASSERT_APPLY_ATTRS; /* fake up C<use attributes $pkg,$rv,@attrs> */ ENTER; /* need to protect against side-effects of 'use' */ - stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no; #define ATTRSMODULE "attributes" #define ATTRSMODULE_PM "attributes.pm" - if (for_my) { - /* Don't force the C<use> if we don't need it. */ - SV * const * const svp = hv_fetchs(GvHVn(PL_incgv), ATTRSMODULE_PM, FALSE); - if (svp && *svp != &PL_sv_undef) - NOOP; /* already in %INC */ - else - Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, - newSVpvs(ATTRSMODULE), NULL); - } - else { - Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS, + Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS, newSVpvs(ATTRSMODULE), NULL, op_prepend_elem(OP_LIST, @@ -2483,7 +2472,6 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) newSVOP(OP_CONST, 0, newRV(target)), dup_attrlist(attrs)))); - } LEAVE; } @@ -2492,7 +2480,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp) { dVAR; OP *pack, *imop, *arg; - SV *meth, *stashsv; + SV *meth, *stashsv, **svp; PERL_ARGS_ASSERT_APPLY_ATTRS_MY; @@ -2504,7 +2492,15 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp) target->op_type == OP_PADAV); /* Ensure that attributes.pm is loaded. */ - apply_attrs(stash, PAD_SV(target->op_targ), attrs, TRUE); + ENTER; /* need to protect against side-effects of 'use' */ + /* Don't force the C<use> if we don't need it. */ + svp = hv_fetchs(GvHVn(PL_incgv), ATTRSMODULE_PM, FALSE); + if (svp && *svp != &PL_sv_undef) + NOOP; /* already in %INC */ + else + Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, + newSVpvs(ATTRSMODULE), NULL); + LEAVE; /* Need package name for method call. */ pack = newSVOP(OP_CONST, 0, newSVpvs(ATTRSMODULE)); @@ -2624,7 +2620,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp) (type == OP_RV2SV ? GvSV(gv) : type == OP_RV2AV ? MUTABLE_SV(GvAV(gv)) : type == OP_RV2HV ? MUTABLE_SV(GvHV(gv)) : MUTABLE_SV(gv)), - attrs, FALSE); + attrs); } o->op_private |= OPpOUR_INTRO; return o; @@ -7243,7 +7239,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) attrs: if (attrs) { /* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */ - apply_attrs(PL_curstash, MUTABLE_SV(cv), attrs, FALSE); + apply_attrs(PL_curstash, MUTABLE_SV(cv), attrs); } if (block) { @@ -7640,7 +7636,7 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, if (attrs) { /* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */ HV *stash = name && GvSTASH(CvGV(cv)) ? GvSTASH(CvGV(cv)) : PL_curstash; - apply_attrs(stash, MUTABLE_SV(cv), attrs, FALSE); + apply_attrs(stash, MUTABLE_SV(cv), attrs); } if (block && has_name) { diff --git a/proto.h b/proto.h index f662929..94ad613 100644 --- a/proto.h +++ b/proto.h @@ -5737,7 +5737,7 @@ STATIC NV S_mulexp10(NV value, I32 exponent); #endif #if defined(PERL_IN_OP_C) PERL_STATIC_INLINE bool S_aassign_common_vars(pTHX_ OP* o); -STATIC void S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) +STATIC void S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); #define PERL_ARGS_ASSERT_APPLY_ATTRS \ diff --git a/t/op/svleak.t b/t/op/svleak.t index b588ffc..e6636b8 100644 --- a/t/op/svleak.t +++ b/t/op/svleak.t @@ -15,7 +15,7 @@ BEGIN { use Config; -plan tests => 27; +plan tests => 28; # run some code N times. If the number of SVs at the end of loop N is # greater than (N-1)*delta at the end of loop 1, we've got a leak @@ -183,3 +183,6 @@ SKIP: { leak(2, 0, sub { eval 'tr/9-0//' }, 'tr/9-0//'); leak(2, 0, sub { eval 'tr/a-z-0//' }, 'tr/a-z-0//'); } + +# [perl #114764] Attributes leak scalars +leak(2, 0, sub { eval 'my $x : shared' }, 'my $x :shared used to leak'); -- Perl5 Master Repository
