In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b3f91e9158d8a5c05627eba1c2848f35528571d2?hp=00c0cb6d254eaba165c8445a6e68686b8285b5a3>
- Log ----------------------------------------------------------------- commit b3f91e9158d8a5c05627eba1c2848f35528571d2 Author: David Mitchell <[email protected]> Date: Sun Jul 18 18:18:50 2010 +0100 add CvGV_set() macro and make CvGV() rvalue only Now that CvGV can sometimes be reference counted, stop people from directly assigning to it (by using CvGV as an lvalue), and instead force them to use CvGV_set() M cv.h M gv.c M op.c M pad.c M pp.c M sv.c commit c794ca97ff43be078aabf556aa282af208d9c38c Author: David Mitchell <[email protected]> Date: Sun Jul 18 16:21:03 2010 +0100 change when to make CvGV refcounted Rather than making CvGV refcounted if the CV is anon, decide based on whether the GV pointed to by CvGV holds a reference back to us. Normally these two will be equivalent, but this way is more robust if people are doing weird things. Also spotted an error with cv_clone not clearing the CVf_CVGV_RC flag on the newly cloned cv. This shouldn't normally matter as it will get set shortly anyway, but best to keep things logically correct. M gv.c M pad.c commit cfc1e951d98ba2b9a0e066aba9aadba4cd919eec Author: David Mitchell <[email protected]> Date: Sun Jul 18 15:07:08 2010 +0100 add CVf_CVGV_RC flag after the recent commit 803f274831f937654d48f8cf0468521cbf8f5dff, the CvGV field is sometimes reference counted. Since it was intended that the reference counting would happen only for anonymous CVs, the CVf_ANON flag was co-opted to indicate whether RC was being used. This is not entirely robust; for example, sub __ANON__ {} is a non-anon sub which points to the same GV used by anon subs, which while itself doesn't directly break things, shows that the potential for breakage is there. So add a separate flag just to indicate the reference count status of the CvGV field. M cv.h M dump.c M ext/Devel-Peek/t/Peek.t M gv.c M op.c M sv.c M t/op/stash.t ----------------------------------------------------------------------- Summary of changes: cv.h | 13 ++++++++----- dump.c | 3 ++- ext/Devel-Peek/t/Peek.t | 4 ++-- gv.c | 20 ++++++++++---------- op.c | 12 ++++++------ pad.c | 4 ++-- pp.c | 2 +- sv.c | 9 +++++---- t/op/stash.t | 11 ++++++++++- 9 files changed, 46 insertions(+), 32 deletions(-) diff --git a/cv.h b/cv.h index fe96aa3..7979a05 100644 --- a/cv.h +++ b/cv.h @@ -41,7 +41,8 @@ Returns the stash of the CV. #define CvROOT(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_root #define CvXSUB(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_xsub #define CvXSUBANY(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_xsubany -#define CvGV(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv +#define CvGV(sv) (0+((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv) +#define CvGV_set(cv,gv) Perl_cvgv_set(aTHX_ cv, gv) #define CvFILE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_file #ifdef USE_ITHREADS # define CvFILE_set_from_cop(sv, cop) (CvFILE(sv) = savepv(CopFILE(cop))) @@ -70,14 +71,12 @@ Returns the stash of the CV. #define CVf_WEAKOUTSIDE 0x0010 /* CvOUTSIDE isn't ref counted */ #define CVf_CLONE 0x0020 /* anon CV uses external lexicals */ #define CVf_CLONED 0x0040 /* a clone of one of those */ -#define CVf_ANON 0x0080 /* implies: CV is not pointed to by a GV, - CvGV is refcounted, and - points to an __ANON__ GV; - at compile time only, also implies sub {} */ +#define CVf_ANON 0x0080 /* CV is not pointed to by a GV */ #define CVf_UNIQUE 0x0100 /* sub is only called once (eg PL_main_cv, * require, eval). */ #define CVf_NODEBUG 0x0200 /* no DB::sub indirection for this CV (esp. useful for special XSUBs) */ +#define CVf_CVGV_RC 0x0400 /* CvGV is reference counted */ /* This symbol for optimised communication between toke.c and op.c: */ #define CVf_BUILTIN_ATTRS (CVf_METHOD|CVf_LVALUE) @@ -131,6 +130,10 @@ Returns the stash of the CV. #define CvISXSUB_on(cv) (CvFLAGS(cv) |= CVf_ISXSUB) #define CvISXSUB_off(cv) (CvFLAGS(cv) &= ~CVf_ISXSUB) +#define CvCVGV_RC(cv) (CvFLAGS(cv) & CVf_CVGV_RC) +#define CvCVGV_RC_on(cv) (CvFLAGS(cv) |= CVf_CVGV_RC) +#define CvCVGV_RC_off(cv) (CvFLAGS(cv) &= ~CVf_CVGV_RC) + /* Flags for newXS_flags */ #define XS_DYNAMIC_FILENAME 0x01 /* The filename isn't static */ diff --git a/dump.c b/dump.c index 120c9b4..843eb88 100644 --- a/dump.c +++ b/dump.c @@ -1499,7 +1499,8 @@ const struct flag_to_name cv_flags_names[] = { {CVf_NODEBUG, "NODEBUG,"}, {CVf_LVALUE, "LVALUE,"}, {CVf_METHOD, "METHOD,"}, - {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"} + {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"}, + {CVf_CVGV_RC, "CVGV_RC,"} }; const struct flag_to_name hv_flags_names[] = { diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 3c90f6e..1fb1a5d 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -261,7 +261,7 @@ do_test(13, RV = $ADDR SV = PVCV\\($ADDR\\) at $ADDR REFCNT = 2 - FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\) + FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC\\) IV = 0 # $] < 5.009 NV = 0 # $] < 5.009 PROTOTYPE = "" @@ -276,7 +276,7 @@ do_test(13, MUTEXP = $ADDR OWNER = $ADDR)? FLAGS = 0x404 # $] < 5.009 - FLAGS = 0x90 # $] >= 5.009 + FLAGS = 0x490 # $] >= 5.009 OUTSIDE_SEQ = \\d+ PADLIST = $ADDR PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\) diff --git a/gv.c b/gv.c index 4764863..a5c33d9 100644 --- a/gv.c +++ b/gv.c @@ -206,26 +206,26 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv) return; if (oldgv) { - if (CvANON(cv)) + if (CvCVGV_RC(cv)) { SvREFCNT_dec(oldgv); + CvCVGV_RC_off(cv); + } else { - assert(strNE(GvNAME(oldgv),"__ANON__")); sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv)); } } - CvGV(cv) = gv; + SvANY(cv)->xcv_gv = gv; + assert(!CvCVGV_RC(cv)); if (!gv) return; - if (CvANON(cv)) { - assert(strnEQ(GvNAME(gv),"__ANON__", 8)); - SvREFCNT_inc_simple_void_NN(gv); - } - else { - assert(strNE(GvNAME(gv),"__ANON__")); + if (isGV_with_GP(gv) && GvGP(gv) && (GvCV(gv) == cv || GvFORM(gv) == cv)) Perl_sv_add_backref(aTHX_ MUTABLE_SV(gv), MUTABLE_SV(cv)); + else { + CvCVGV_RC_on(cv); + SvREFCNT_inc_simple_void_NN(gv); } } @@ -303,7 +303,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) LEAVE; mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar($) { (shift) } sub ASDF::baz($); *ASDF::baz = \&Foo::bar */ - cvgv_set(cv, gv); + CvGV_set(cv, gv); CvFILE_set_from_cop(cv, PL_curcop); CvSTASH(cv) = PL_curstash; if (PL_curstash) diff --git a/op.c b/op.c index e5f9604..276e100 100644 --- a/op.c +++ b/op.c @@ -5459,7 +5459,7 @@ Perl_cv_undef(pTHX_ CV *cv) LEAVE; } SvPOK_off(MUTABLE_SV(cv)); /* forget prototype */ - cvgv_set(cv, NULL); + CvGV_set(cv, NULL); pad_undef(cv); @@ -5476,9 +5476,9 @@ Perl_cv_undef(pTHX_ CV *cv) if (CvISXSUB(cv) && CvXSUB(cv)) { CvXSUB(cv) = NULL; } - /* delete all flags except WEAKOUTSIDE and ANON, which indicate the + /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the * ref status of CvOUTSIDE and CvGV */ - CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_ANON); + CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC); } void @@ -5872,7 +5872,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } } if (!CvGV(cv)) { - cvgv_set(cv, gv); + CvGV_set(cv, gv); CvFILE_set_from_cop(cv, PL_curcop); CvSTASH(cv) = PL_curstash; if (PL_curstash) @@ -6236,7 +6236,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename) } if (!name) CvANON_on(cv); - cvgv_set(cv, gv); + CvGV_set(cv, gv); (void)gv_fetchfile(filename); CvFILE(cv) = (char *)filename; /* NOTE: not copied, as it is expected to be an external constant string */ @@ -6285,7 +6285,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) } cv = PL_compcv; GvFORM(gv) = cv; - cvgv_set(cv, gv); + CvGV_set(cv, gv); CvFILE_set_from_cop(cv, PL_curcop); diff --git a/pad.c b/pad.c index fa9f55a..0b3c948 100644 --- a/pad.c +++ b/pad.c @@ -1562,7 +1562,7 @@ Perl_cv_clone(pTHX_ CV *proto) SAVESPTR(PL_compcv); cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto))); - CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE); + CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC); CvCLONED_on(cv); #ifdef USE_ITHREADS @@ -1571,7 +1571,7 @@ Perl_cv_clone(pTHX_ CV *proto) #else CvFILE(cv) = CvFILE(proto); #endif - cvgv_set(cv,CvGV(proto)); + CvGV_set(cv,CvGV(proto)); CvSTASH(cv) = CvSTASH(proto); if (CvSTASH(cv)) Perl_sv_add_backref(aTHX_ MUTABLE_SV(CvSTASH(cv)), MUTABLE_SV(cv)); diff --git a/pp.c b/pp.c index a78c1cc..129c948 100644 --- a/pp.c +++ b/pp.c @@ -838,7 +838,7 @@ PP(pp_undef) /* let user-undef'd sub keep its identity */ GV* const gv = CvGV((const CV *)sv); cv_undef(MUTABLE_CV(sv)); - cvgv_set(MUTABLE_CV(sv), gv); + CvGV_set(MUTABLE_CV(sv), gv); } break; case SVt_PVGV: diff --git a/sv.c b/sv.c index f555fc1..10e41a9 100644 --- a/sv.c +++ b/sv.c @@ -5675,7 +5675,7 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv) /* will the CV shortly be freed by gp_free() ? */ if (GvCV(gv) == cv && GvGP(gv)->gp_refcnt < 2 && SvREFCNT(cv) < 2) { - CvGV(cv) = NULL; + SvANY(cv)->xcv_gv = NULL; return; } @@ -5687,7 +5687,8 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv) SvREFCNT_dec(gvname); CvANON_on(cv); - CvGV(cv) = MUTABLE_GV(SvREFCNT_inc(anongv)); + CvCVGV_RC_on(cv); + SvANY(cv)->xcv_gv = MUTABLE_GV(SvREFCNT_inc(anongv)); } @@ -11437,8 +11438,8 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param) } /* don't dup if copying back - CvGV isn't refcounted, so the * duped GV may never be freed. A bit of a hack! DAPM */ - CvGV(dstr) = - CvANON(dstr) + SvANY(MUTABLE_CV(dstr))->xcv_gv = + CvCVGV_RC(dstr) ? gv_dup_inc(CvGV(sstr), param) : (param->flags & CLONEf_JOIN_IN) ? NULL diff --git a/t/op/stash.t b/t/op/stash.t index 81ca233..2c17022 100644 --- a/t/op/stash.t +++ b/t/op/stash.t @@ -7,7 +7,7 @@ BEGIN { BEGIN { require "./test.pl"; } -plan( tests => 37 ); +plan( tests => 38 ); # Used to segfault (bug #15479) fresh_perl_like( @@ -200,3 +200,12 @@ SKIP: { is($gv->NAME, '__ANON__', "anon CV has anon GV"); } } + +# make sure having a sub called __ANON__ doesn't confuse perl. + +{ + my $c; + sub __ANON__ { $c = (caller(0))[3]; } + __ANON__(); + is ($c, 'main::__ANON__', '__ANON__ sub called ok'); +} -- Perl5 Master Repository
