}
/* Void wrapper to pass to visit() */
-/* XXX
static void
do_curse(pTHX_ SV * const sv) {
if ((PL_stderrgv && GvGP(PL_stderrgv) && (SV*)GvIO(PL_stderrgv) == sv)
return;
(void)curse(sv, 0);
}
-*/
/*
=for apidoc sv_clean_objs
visit(do_clean_named_io_objs, SVt_PVGV|SVpgv_GP, SVTYPEMASK|SVp_POK|SVpgv_GP);
/* And if there are some very tenacious barnacles clinging to arrays,
closures, or what have you.... */
- /* XXX This line breaks Tk and Gtk2. See [perl #82542].
visit(do_curse, SVs_OBJECT, SVs_OBJECT);
- */
olddef = PL_defoutgv;
PL_defoutgv = NULL; /* disable skip of PL_defoutgv */
if (olddef && isGV_with_GP(olddef))
mro_changes = 2;
else {
const STRLEN len = GvNAMELEN(dstr);
- if (len > 1 && name[len-2] == ':' && name[len-1] == ':') {
+ if ((len > 1 && name[len-2] == ':' && name[len-1] == ':')
+ || (len == 1 && name[0] == ':')) {
mro_changes = 3;
/* Set aside the old stash, so we can reset isa caches on
const char * const name = GvNAME((GV*)dstr);
const STRLEN len = GvNAMELEN(dstr);
if (
- len > 1 && name[len-2] == ':' && name[len-1] == ':'
+ (
+ (len > 1 && name[len-2] == ':' && name[len-1] == ':')
+ || (len == 1 && name[0] == ':')
+ )
&& (!dref || HvENAME_get(dref))
) {
mro_package_moved(
const STRLEN len = GvNAMELEN(dstr);
HV *old_stash = NULL;
bool reset_isa = FALSE;
- if (len > 1 && name[len-2] == ':' && name[len-1] == ':') {
+ if ((len > 1 && name[len-2] == ':' && name[len-1] == ':')
+ || (len == 1 && name[0] == ':')) {
/* Set aside the old stash, so we can reset isa caches
on its subclasses. */
if((old_stash = GvHV(dstr))) {
}
}
-int
+static int
S_sv_unmagicext_flags(pTHX_ SV *const sv, const int type, MGVTBL *vtbl, const U32 flags)
{
MAGIC* mg;
* store it directly in the HvAUX or mg_obj slot, avoiding the need to
* allocate an AV. (Whether the slot holds an AV tells us whether this is
* active.)
- *
- * If an HV's backref is stored in magic, it is moved back to HvAUX.
*/
/* A discussion about the backreferences array and its refcount:
*
* The AV holding the backreferences is pointed to either as the mg_obj of
- * PERL_MAGIC_backref, or in the specific case of a HV that has the hv_aux
- * structure, from the xhv_backreferences field. (A HV without hv_aux will
- * have the standard magic instead.) The array is created with a refcount
+ * PERL_MAGIC_backref, or in the specific case of a HV, from the
+ * xhv_backreferences field. The array is created with a refcount
* of 2. This means that if during global destruction the array gets
* picked on before its parent to have its refcount decremented by the
* random zapper, it won't actually be freed, meaning it's still there for
if (SvTYPE(tsv) == SVt_PVHV) {
svp = (SV**)Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(tsv));
-
- if (!*svp) {
- if ((mg = mg_find(tsv, PERL_MAGIC_backref))) {
- /* Aha. They've got it stowed in magic instead.
- * Move it back to xhv_backreferences */
- *svp = mg->mg_obj;
- /* Stop mg_free decreasing the reference count. */
- mg->mg_obj = NULL;
- /* Stop mg_free even calling the destructor, given that
- there's no AV to free up. */
- mg->mg_virtual = 0;
- sv_unmagic(tsv, PERL_MAGIC_backref);
- mg = NULL;
- }
- }
} else {
if (! ((mg =
(SvMAGICAL(tsv) ? mg_find(tsv, PERL_MAGIC_backref) : NULL))))
PERL_ARGS_ASSERT_SV_DEL_BACKREF;
- if (SvTYPE(tsv) == SVt_PVHV && SvOOK(tsv)) {
- svp = (SV**)Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(tsv));
+ if (SvTYPE(tsv) == SVt_PVHV) {
+ if (SvOOK(tsv))
+ svp = (SV**)Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(tsv));
}
- if (!svp || !*svp) {
+ else {
MAGIC *const mg
= SvMAGICAL(tsv) ? mg_find(tsv, PERL_MAGIC_backref) : NULL;
svp = mg ? &(mg->mg_obj) : NULL;
if (!av)
return;
+ /* after multiple passes through Perl_sv_clean_all() for a thinngy
+ * that has badly leaked, the backref array may have gotten freed,
+ * since we only protect it against 1 round of cleanup */
+ if (SvIS_FREED(av)) {
+ if (PL_in_clean_all) /* All is fair */
+ return;
+ Perl_croak(aTHX_
+ "panic: magic_killbackrefs (freed backref AV/SV)");
+ }
+
+
is_array = (SvTYPE(av) == SVt_PVAV);
if (is_array) {
assert(!SvIS_FREED(av));
}
/* if not, anonymise: */
- stash = GvSTASH(gv) ? HvNAME(GvSTASH(gv)) : NULL;
+ stash = GvSTASH(gv) && HvNAME(GvSTASH(gv))
+ ? HvENAME(GvSTASH(gv)) : NULL;
gvname = Perl_newSVpvf(aTHX_ "%s::__ANON__",
stash ? stash : "__ANON__");
anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV);
if (type >= SVt_PVMG) {
/* Free back-references before magic, in case the magic calls
* Perl code that has weak references to sv. */
- if (type == SVt_PVHV)
+ if (type == SVt_PVHV) {
Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
- if (type == SVt_PVMG && SvPAD_OUR(sv)) {
+ if (SvMAGIC(sv))
+ mg_free(sv);
+ }
+ else if (type == SVt_PVMG && SvPAD_OUR(sv)) {
SvREFCNT_dec(SvOURSTASH(sv));
} else if (SvMAGIC(sv)) {
/* Free back-references before other types of magic. */
PL_last_swash_hv = NULL;
}
Perl_hv_undef_flags(aTHX_ MUTABLE_HV(sv), HV_NAME_SETALL);
+ assert(!HvARRAY((HV*)sv));
break;
case SVt_PVAV:
{