- SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */
- SvOBJECT_off(sv); /* Curse the object. */
- if (type != SVt_PVIO)
- --PL_sv_objcount; /* XXX Might want something more general */
- }
- }
- if (type >= SVt_PVMG) {
- if (type == SVt_PVMG && SvPAD_OUR(sv)) {
- SvREFCNT_dec(SvOURSTASH(sv));
- } else if (SvMAGIC(sv))
- mg_free(sv);
- if (type == SVt_PVMG && SvPAD_TYPED(sv))
- SvREFCNT_dec(SvSTASH(sv));
- }
- switch (type) {
- /* case SVt_BIND: */
- case SVt_PVIO:
- if (IoIFP(sv) &&
- IoIFP(sv) != PerlIO_stdin() &&
- IoIFP(sv) != PerlIO_stdout() &&
- IoIFP(sv) != PerlIO_stderr() &&
- !(IoFLAGS(sv) & IOf_FAKE_DIRP))
- {
- io_close(MUTABLE_IO(sv), FALSE);
- }
- if (IoDIRP(sv) && !(IoFLAGS(sv) & IOf_FAKE_DIRP))
- PerlDir_close(IoDIRP(sv));
- IoDIRP(sv) = (DIR*)NULL;
- Safefree(IoTOP_NAME(sv));
- Safefree(IoFMT_NAME(sv));
- Safefree(IoBOTTOM_NAME(sv));
- goto freescalar;
- case SVt_REGEXP:
- /* FIXME for plugins */
- pregfree2((REGEXP*) sv);
- goto freescalar;
- case SVt_PVCV:
- case SVt_PVFM:
- cv_undef(MUTABLE_CV(sv));
- /* If we're in a stash, we don't own a reference to it. However it does
- have a back reference to us, which needs to be cleared. */
- if ((stash = CvSTASH(sv)))
- sv_del_backref(MUTABLE_SV(stash), sv);
- goto freescalar;
- case SVt_PVHV:
- if (PL_last_swash_hv == (const HV *)sv) {
- PL_last_swash_hv = NULL;
- }
- Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
- hv_undef(MUTABLE_HV(sv));
- break;
- case SVt_PVAV:
- if (PL_comppad == MUTABLE_AV(sv)) {
- PL_comppad = NULL;
- PL_curpad = NULL;
- }
- av_undef(MUTABLE_AV(sv));
- break;
- case SVt_PVLV:
- if (LvTYPE(sv) == 'T') { /* for tie: return HE to pool */
- SvREFCNT_dec(HeKEY_sv((HE*)LvTARG(sv)));
- HeNEXT((HE*)LvTARG(sv)) = PL_hv_fetch_ent_mh;
- PL_hv_fetch_ent_mh = (HE*)LvTARG(sv);
- }
- else if (LvTYPE(sv) != 't') /* unless tie: unrefcnted fake SV** */
- SvREFCNT_dec(LvTARG(sv));
- case SVt_PVGV:
- if (isGV_with_GP(sv)) {
- if(GvCVu((const GV *)sv) && (stash = GvSTASH(MUTABLE_GV(sv)))
- && HvNAME_get(stash))
- mro_method_changed_in(stash);
- gp_free(MUTABLE_GV(sv));
- if (GvNAME_HEK(sv))
- unshare_hek(GvNAME_HEK(sv));
- /* If we're in a stash, we don't own a reference to it. However it does
- have a back reference to us, which needs to be cleared. */
- if (!SvVALID(sv) && (stash = GvSTASH(sv)))
- sv_del_backref(MUTABLE_SV(stash), sv);
- }
- /* FIXME. There are probably more unreferenced pointers to SVs in the
- interpreter struct that we should check and tidy in a similar
- fashion to this: */
- if ((const GV *)sv == PL_last_in_gv)
- PL_last_in_gv = NULL;
- case SVt_PVMG:
- case SVt_PVNV:
- case SVt_PVIV:
- case SVt_PV:
- freescalar:
- /* Don't bother with SvOOK_off(sv); as we're only going to free it. */
- if (SvOOK(sv)) {
- STRLEN offset;
- SvOOK_offset(sv, offset);
- SvPV_set(sv, SvPVX_mutable(sv) - offset);
- /* Don't even bother with turning off the OOK flag. */
+ if (!curse(sv, 1)) goto get_next_sv;
+ }
+ 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)
+ Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
+ if (type == SVt_PVMG && SvPAD_OUR(sv)) {
+ SvREFCNT_dec(SvOURSTASH(sv));
+ } else if (SvMAGIC(sv)) {
+ /* Free back-references before other types of magic. */
+ sv_unmagic(sv, PERL_MAGIC_backref);
+ mg_free(sv);
+ }
+ if (type == SVt_PVMG && SvPAD_TYPED(sv))
+ SvREFCNT_dec(SvSTASH(sv));