else if (*name == '-' || *name == '+')
require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
}
+ else if (len == 3 && sv_type == SVt_PVAV
+ && strnEQ(name, "ISA", 3)
+ && (!GvAV(gv) || !SvSMAGICAL(GvAV(gv))))
+ gv_magicalize_isa(gv);
}
return gv;
} else if (no_init) {
if (strEQ(name2, "NCODING"))
goto magicalize;
break;
+ case '\007': /* $^GLOBAL_PHASE */
+ if (strEQ(name2, "LOBAL_PHASE"))
+ goto ro_magicalize;
+ break;
case '\015': /* $^MATCH */
if (strEQ(name2, "ATCH"))
goto magicalize;
break;
case '\020': /* $^PREMATCH $^POSTMATCH */
if (strEQ(name2, "REMATCH") || strEQ(name2, "OSTMATCH"))
- goto magicalize;
+ goto magicalize;
+ break;
case '\024': /* ${^TAINT} */
if (strEQ(name2, "AINT"))
goto ro_magicalize;
return FALSE;
}
+SV *
+Perl_amagic_deref_call(pTHX_ SV *ref, int method) {
+ SV *tmpsv = NULL;
+
+ PERL_ARGS_ASSERT_AMAGIC_DEREF_CALL;
+
+ while (SvAMAGIC(ref) &&
+ (tmpsv = amagic_call(ref, &PL_sv_undef, method,
+ AMGf_noright | AMGf_unary))) {
+ if (!SvROK(tmpsv))
+ Perl_croak(aTHX_ "Overloaded dereference did not return a reference");
+ if (tmpsv == ref || SvRV(tmpsv) == SvRV(ref)) {
+ /* Bail out if it returns us the same reference. */
+ return tmpsv;
+ }
+ ref = tmpsv;
+ }
+ return tmpsv ? tmpsv : ref;
+}
SV*
Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
&& (assign || (method == inc_amg) || (method == dec_amg)))
|| force_cpy)
{
- RvDEEPCP(left);
+ /* newSVsv does not behave as advertised, so we copy missing
+ * information by hand */
+ SV *tmpRef = SvRV(left);
+ SV *rv_copy;
+ if (SvREFCNT(tmpRef) > 1 && (rv_copy = AMG_CALLun(left,copy))) {
+ SvRV_set(left, rv_copy);
+ SvSETMAGIC(left);
+ SvREFCNT_dec(tmpRef);
+ }
}
{
/* XXX Why and where does this leave dangling pointers during global
destruction? */
- if (PL_dirty) return;
+ if (PL_phase == PERL_PHASE_DESTRUCT) return;
if (!(SvREFCNT(gv) == 1 && SvTYPE(gv) == SVt_PVGV && !SvFAKE(gv) &&
!SvOBJECT(gv) && !SvREADONLY(gv) &&