diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2012-05-17 22:26:20 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2012-05-21 18:09:24 -0700 |
| commit | a1cd65be3e8d2e7a6b4edef2ff5eee74e79cf497 (patch) | |
| tree | e32a148ea20b616ffb7bf2a8262e2bff9c9deb97 | |
| parent | 54f6ba105424d583f3ad66ad05790975c5d7a86d (diff) | |
| download | perl-a1cd65be3e8d2e7a6b4edef2ff5eee74e79cf497.tar.gz | |
Move SvAMAGIC flag from object to stash
By putting the flag on the stash, we can allow the overloaded status
of all objects of a particular class to change without having to
change the flag on every object (which would require traversing arenas
or keeping caches).
This partially fixes bug #112708, in that objects that existed before
their class had any overloading will start working after overloading
is introduced if other objects are blessed into that class.
Without blessings of other objects, they still don’t work yet. The
fix for that is yet to come....
This was also a good excuse for deleting a comment that contained two
typos. :-)
| -rw-r--r-- | gv.c | 8 | ||||
| -rw-r--r-- | lib/overload.t | 2 | ||||
| -rw-r--r-- | sv.h | 19 |
3 files changed, 17 insertions, 12 deletions
@@ -2691,12 +2691,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) */ SV* const newref = newSVsv(tmpRef); SvOBJECT_on(newref); - /* As a bit of a source compatibility hack, SvAMAGIC() and - friends dereference an RV, to behave the same was as when - overloading was stored on the reference, not the referant. - Hence we can't use SvAMAGIC_on() - */ - SvFLAGS(newref) |= SVf_AMAGIC; + /* No need to do SvAMAGIC_on here, as SvAMAGIC macros + delegate to the stash. */ SvSTASH_set(newref, MUTABLE_HV(SvREFCNT_inc(SvSTASH(tmpRef)))); return newref; } diff --git a/lib/overload.t b/lib/overload.t index 54eb75cb9d..045dc6063e 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -2210,8 +2210,10 @@ sub thirteentative::abs { 'thirteen' } eval 'package eleventative; use overload map +($_)x2, cos=>abs=>'; is cos $o, 'eleven', 'overloading applies to object blessed before'; bless [], 'eleventative'; + undef $TODO; is cos $o, 'eleven', 'ovrld applies to previously-blessed obj after other obj is blessed'; + $TODO = '[perl #112708]'; $o = bless [], 'eleventative'; *eleventative::cos = sub { 'ten' }; is cos $o, 'ten', 'method changes affect overloading'; @@ -879,20 +879,27 @@ in gv.h: */ #define SvRMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_RMG) #define SvRMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_RMG) -#define SvAMAGIC(sv) (SvROK(sv) && (SvFLAGS(SvRV(sv)) & SVf_AMAGIC)) +#define SvAMAGIC(sv) (SvROK(sv) && SvOBJECT(SvRV(sv)) && \ + SvFLAGS(SvSTASH(SvRV(sv))) & SVf_AMAGIC) #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) # define SvAMAGIC_on(sv) ({ SV * const kloink = sv; \ assert(SvROK(kloink)); \ - SvFLAGS(SvRV(kloink)) |= SVf_AMAGIC; \ + if (SvOBJECT(SvRV(kloink))) \ + SvFLAGS(SvSTASH(SvRV(kloink))) \ + |= SVf_AMAGIC; \ }) # define SvAMAGIC_off(sv) ({ SV * const kloink = sv; \ - if(SvROK(kloink)) \ - SvFLAGS(SvRV(kloink)) &= ~SVf_AMAGIC;\ + if(SvROK(kloink) \ + && SvOBJECT(SvRV(kloink))) \ + SvFLAGS(SvSTASH(SvRV(kloink))) \ + &= ~SVf_AMAGIC; \ }) #else -# define SvAMAGIC_on(sv) (SvFLAGS(SvRV(sv)) |= SVf_AMAGIC) +# define SvAMAGIC_on(sv) \ + SvOBJECT(SvRV(sv)) && (SvFLAGS(SvSTASH(SvRV(sv))) |= SVf_AMAGIC) # define SvAMAGIC_off(sv) \ - (SvROK(sv) && (SvFLAGS(SvRV(sv)) &= ~SVf_AMAGIC)) + (SvROK(sv) && SvOBJECT(SvRV(sv)) \ + && (SvFLAGS(SvSTASH(SvRV(sv))) &= ~SVf_AMAGIC)) #endif /* |