Blob Blame History Raw
--- perl-5.8.8/sv.c.U27512	2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/sv.c	2006-06-01 19:13:32.000000000 -0400
@@ -7993,6 +7993,52 @@
     return rv;
 }
 
+/* This is a hack to cope with reblessing from class with overloading magic to
+   one without (or the other way).  Search for every reference pointing to the
+   object.  Can't use S_visit() because we would need to pass a parameter to
+   our function.  */
+static void
+S_reset_amagic(pTHX_ SV *rv, const bool on) {
+    /* It is assumed that you've already turned magic on/off on rv  */
+    SV* sva;
+    SV *const target = SvRV(rv);
+    /* Less 1 for the reference we've already dealt with.  */
+    U32 how_many = SvREFCNT(target) - 1;
+    MAGIC *mg;
+
+    if (SvMAGICAL(target) && (mg = mg_find(target, PERL_MAGIC_backref))) {
+	/* Back referneces also need to be found, but aren't part of the
+	   target's reference count.  */
+	how_many += 1 + av_len((AV*)mg->mg_obj);
+    }
+
+    if (!how_many) {
+	/* There was only 1 reference to this object.  */
+	return;
+    }
+
+    for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
+	register const SV * const svend = &sva[SvREFCNT(sva)];
+	register SV* sv;
+	for (sv = sva + 1; sv < svend; ++sv) {
+	    if (SvTYPE(sv) != SVTYPEMASK
+		&& (sv->sv_flags & SVf_ROK) == SVf_ROK
+		&& SvREFCNT(sv)
+		&& SvRV(sv) == target
+		&& sv != rv) {
+		if (on)
+		    SvAMAGIC_on(sv);
+		else
+		    SvAMAGIC_off(sv);
+		if (--how_many == 0) {
+		    /* We have found them all.  */
+		    return;
+		}
+	    }
+	}
+    }
+}
+
 /*
 =for apidoc sv_bless
 
@@ -8025,10 +8071,17 @@
     (void)SvUPGRADE(tmpRef, SVt_PVMG);
     SvSTASH_set(tmpRef, (HV*)SvREFCNT_inc(stash));
 
-    if (Gv_AMG(stash))
-	SvAMAGIC_on(sv);
-    else
-	SvAMAGIC_off(sv);
+    if (Gv_AMG(stash)) {
+	if (!SvAMAGIC(sv)) {
+	    SvAMAGIC_on(sv);
+	    S_reset_amagic(aTHX_ sv, TRUE);
+	}
+    } else {
+	if (SvAMAGIC(sv)) {
+	    SvAMAGIC_off(sv);
+	    S_reset_amagic(aTHX_ sv, FALSE);
+	}
+    }
 
     if(SvSMAGICAL(tmpRef))
         if(mg_find(tmpRef, PERL_MAGIC_ext) || mg_find(tmpRef, PERL_MAGIC_uvar))
--- perl-5.8.8/proto.h.U27512	2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/proto.h	2006-06-01 19:13:32.000000000 -0400
@@ -1875,6 +1875,7 @@
 #
 STATIC bool	S_utf8_mg_pos(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 *offsetp, I32 uoff, const U8 **sp, const U8 *start, const U8 *send);
 STATIC bool	S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i, I32 offsetp, const U8 *s, const U8 *start);
+STATIC void	S_reset_amagic(pTHX_ SV *rv, const bool on);
 #endif
 
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
--- perl-5.8.8/embed.h.U27512	2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/embed.h	2006-06-01 19:13:32.000000000 -0400
@@ -1348,6 +1348,7 @@
 #ifdef PERL_CORE
 #define utf8_mg_pos		S_utf8_mg_pos
 #define utf8_mg_pos_init	S_utf8_mg_pos_init
+#define reset_amagic		S_reset_amagic
 #endif
 #endif
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
@@ -3390,6 +3391,7 @@
 #ifdef PERL_CORE
 #define utf8_mg_pos(a,b,c,d,e,f,g,h,i)	S_utf8_mg_pos(aTHX_ a,b,c,d,e,f,g,h,i)
 #define utf8_mg_pos_init(a,b,c,d,e,f,g)	S_utf8_mg_pos_init(aTHX_ a,b,c,d,e,f,g)
+#define reset_amagic(a,b)	S_reset_amagic(aTHX_ a,b)
 #endif
 #endif
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)
--- perl-5.8.8/embed.fnc.U27512	2006-06-01 18:43:19.000000000 -0400
+++ perl-5.8.8/embed.fnc	2006-06-01 19:13:32.000000000 -0400
@@ -1276,6 +1276,7 @@
 s	|bool	|utf8_mg_pos_init	|NN SV *sv|NN MAGIC **mgp \
 				|NN STRLEN **cachep|I32 i|I32 offsetp \
 				|NN const U8 *s|NN const U8 *start
+s	|void	|reset_amagic	|NN SV *rv|const bool on
 #endif
 
 #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT)