--- 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)