116 lines
3.6 KiB
Diff
116 lines
3.6 KiB
Diff
--- 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)
|