protect CvGV weakref with backref

Each CV usually has a pointer, CvGV(cv), back to the GV that corresponds
to the CV's name (or to *foo::__ANON__ for anon CVs).  This pointer wasn't
reference counted, to avoid loops. This could leave it dangling if the GV
is deleted.

We fix this by:

For named subs, adding backref magic to the GV, so that when the GV is
freed, it can trigger processing the CV's CvGV field. This processing
consists of: if it looks like the freeing of the GV is about to trigger
freeing of the CV too, set it to NULL; otherwise make it point to
*foo::__ANON__ (and set CvAONON(cv)).

For anon subs, make CvGV a strong reference, i.e. increment the refcnt of
*foo::__ANON__. This doesn't cause a loop, since in this case the
__ANON__ glob doesn't point to the CV. This also avoids dangling pointers
if someone does an explicit 'delete $foo::{__ANON__}'.

Note that there was already some partial protection for CvGV with
commit f1c32fec87699aee2eeb638f44135f21217d2127. This worked by
anonymising any corresponding CV when freeing a stash or stash entry.
This had two drawbacks. First it didn't fix CVs that were anonmous or that
weren't currently pointed to by the GV (e.g. after local *foo), and
second, it caused *all* CVs to get anonymised during cleanup, even the
ones that would have been deleted shortly afterwards anyway. This commit
effectively removes that former commit, while reusing a bit of the
actual anonymising code.

1 files changed, 11 insertions, 5 deletions

diff --git a/proto.h b/proto.h
index 727d3d5b0e..6a5110ea27 100644
--- a/proto.h
+++ b/proto.h
@@ -959,6 +959,11 @@ PERL_CALLCONV GP *	Perl_newGP(pTHX_ GV *const gv)
 #define PERL_ARGS_ASSERT_NEWGP	\
 	assert(gv)
 
+PERL_CALLCONV void	Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CVGV_SET	\
+	assert(cv)
+
 PERL_CALLCONV void	Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_3);
@@ -4489,11 +4494,6 @@ STATIC void	S_hfreeentries(pTHX_ HV *hv)
 #define PERL_ARGS_ASSERT_HFREEENTRIES	\
 	assert(hv)
 
-STATIC I32	S_anonymise_cv(pTHX_ HEK *stash, SV *val)
-			__attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_ANONYMISE_CV	\
-	assert(val)
-
 STATIC HE*	S_new_he(pTHX)
 			__attribute__malloc__
 			__attribute__warn_unused_result__;
@@ -5901,6 +5901,12 @@ STATIC PTR_TBL_ENT_t *	S_ptr_table_find(PTR_TBL_t *const tbl, const void *const
 #define PERL_ARGS_ASSERT_PTR_TABLE_FIND	\
 	assert(tbl)
 
+STATIC void	S_anonymise_cv_maybe(pTHX_ GV *gv, CV *cv)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_ANONYMISE_CV_MAYBE	\
+	assert(gv); assert(cv)
+
 #endif
 
 #if defined(PERL_IN_TOKE_C)