Moving the overloading flag from the reference to the referant allows

(re)?blessing of overloaded objects to work correctly.

p4raw-id: //depot/perl@27506

diff --git a/dump.c b/dump.c
index 650c1ab..8d4f063 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1196,8 +1196,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     if (flags & SVf_FAKE)      sv_catpv(d, "FAKE,");
     if (flags & SVf_READONLY)  sv_catpv(d, "READONLY,");
 
-    if (flags & SVf_AMAGIC && type != SVt_PVHV)
-                               sv_catpv(d, "OVERLOAD,");
+    if (flags & SVf_AMAGIC)    sv_catpv(d, "OVERLOAD,");
     if (flags & SVp_IOK)       sv_catpv(d, "pIOK,");
     if (flags & SVp_NOK)       sv_catpv(d, "pNOK,");
     if (flags & SVp_POK)       sv_catpv(d, "pPOK,");

diff --git a/lib/overload.t b/lib/overload.t
index 7854860..cf553ce 100644 (file)
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -47,7 +47,7 @@ sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead
 package main;
 
 $| = 1;
-use Test::More tests=>497;
+use Test::More tests=>503;
 
 
 $a = new Oscalar "087";
@@ -1180,3 +1180,48 @@ foreach my $op (qw(<=> == != < <= > >=)) {
     BEGIN { overload::constant integer => sub { 23 } }
     is(eval "17", $twenty_three);
 }
+
+{
+    package Sklorsh;
+    use overload
+       bool     => sub { shift->is_cool };
+
+    sub is_cool {
+       $_[0]->{name} eq 'cool';
+    }
+
+    sub delete {
+       undef %{$_[0]};
+       bless $_[0], 'Brap';
+       return 1;
+    }
+
+    sub delete_with_self {
+       my $self = shift;
+       undef %$self;
+       bless $self, 'Brap';
+       return 1;
+    }
+
+    package Brap;
+
+    1;
+
+    package main;
+
+    my $obj;
+    $obj = bless {name => 'cool'}, 'Sklorsh';
+    $obj->delete;
+    ok(eval {if ($obj) {1}; 1}, $@ || 'reblessed into nonexist namespace');
+
+    $obj = bless {name => 'cool'}, 'Sklorsh';
+    $obj->delete_with_self;
+    ok (eval {if ($obj) {1}; 1}, $@);
+    
+    my $a = $b = {name => 'hot'};
+    bless $b, 'Sklorsh';
+    is(ref $a, 'Sklorsh');
+    is(ref $b, 'Sklorsh');
+    ok(!$b, "Expect overloaded boolean");
+    ok(!$a, "Expect overloaded boolean");
+}

diff --git a/sv.c b/sv.c
index e5e997c..147d13b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3652,7 +3652,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            if (sflags & SVf_IVisUV)
                SvIsUV_on(dstr);
        }
-       SvFLAGS(dstr) |= sflags & (SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK|SVf_UTF8);
+       SvFLAGS(dstr) |= sflags & (SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK|SVf_UTF8
+                                  |SVf_AMAGIC);
        {
            const MAGIC * const smg = SvVOK(sstr);
            if (smg) {
@@ -3664,7 +3665,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
     }
     else if (sflags & (SVp_IOK|SVp_NOK)) {
        (void)SvOK_off(dstr);
-       SvFLAGS(dstr) |= sflags & (SVf_IOK|SVp_IOK|SVf_IVisUV|SVf_NOK|SVp_NOK);
+       SvFLAGS(dstr) |= sflags & (SVf_IOK|SVp_IOK|SVf_IVisUV|SVf_NOK|SVp_NOK
+                                  |SVf_AMAGIC);
        if (sflags & SVp_IOK) {
            /* XXXX Do we want to set IsUV for IV(ROK)?  Be extra safe... */
            SvIV_set(dstr, SvIVX(sstr));
@@ -3684,6 +3686,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            SvFAKE_off(sstr);
            gv_efullname3(dstr, (GV *)sstr, "*");
            SvFLAGS(sstr) |= wasfake;
+           SvFLAGS(dstr) |= sflags & SVf_AMAGIC;
        }
        else
            (void)SvOK_off(dstr);

diff --git a/sv.h b/sv.h
index 4461a3c..f2f2fea 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -865,11 +865,11 @@ Set the actual length of the string which is in the SV.  See C<SvIV_set>.
 
 #define SvOK(sv)               (SvFLAGS(sv) & SVf_OK)
 #define SvOK_off(sv)           (assert_not_ROK(sv) assert_not_glob(sv) \
-                                SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC|    \
+                                SvFLAGS(sv) &= ~(SVf_OK|               \
                                                  SVf_IVisUV|SVf_UTF8), \
                                                        SvOOK_off(sv))
 #define SvOK_off_exc_UV(sv)    (assert_not_ROK(sv)                     \
-                                SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC|    \
+                                SvFLAGS(sv) &= ~(SVf_OK|               \
                                                  SVf_UTF8),            \
                                                        SvOOK_off(sv))
 
@@ -938,11 +938,11 @@ in gv.h: */
                                 SvFLAGS(sv) |= (SVf_POK|SVp_POK))
 #define SvPOK_off(sv)          (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK))
 #define SvPOK_only(sv)         (assert_not_ROK(sv) assert_not_glob(sv) \
-                                SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC|    \
+                                SvFLAGS(sv) &= ~(SVf_OK|               \
                                                  SVf_IVisUV|SVf_UTF8), \
                                    SvFLAGS(sv) |= (SVf_POK|SVp_POK))
 #define SvPOK_only_UTF8(sv)    (assert_not_ROK(sv) assert_not_glob(sv) \
-                                SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC|    \
+                                SvFLAGS(sv) &= ~(SVf_OK|               \
                                                  SVf_IVisUV),          \
                                    SvFLAGS(sv) |= (SVf_POK|SVp_POK))
 
@@ -958,7 +958,7 @@ in gv.h: */
 
 #define SvROK(sv)              (SvFLAGS(sv) & SVf_ROK)
 #define SvROK_on(sv)           (SvFLAGS(sv) |= SVf_ROK)
-#define SvROK_off(sv)          (SvFLAGS(sv) &= ~(SVf_ROK|SVf_AMAGIC))
+#define SvROK_off(sv)          (SvFLAGS(sv) &= ~(SVf_ROK))
 
 #define SvMAGICAL(sv)          (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG))
 #define SvMAGICAL_on(sv)       (SvFLAGS(sv) |= (SVs_GMG|SVs_SMG|SVs_RMG))
@@ -976,11 +976,22 @@ in gv.h: */
 #define SvRMAGICAL_on(sv)      (SvFLAGS(sv) |= SVs_RMG)
 #define SvRMAGICAL_off(sv)     (SvFLAGS(sv) &= ~SVs_RMG)
 
-#define SvAMAGIC(sv)           (SvFLAGS(sv) & SVf_AMAGIC)
-#define SvAMAGIC_on(sv)                (SvFLAGS(sv) |= SVf_AMAGIC)
-#define SvAMAGIC_off(sv)       (SvFLAGS(sv) &= ~SVf_AMAGIC)
+#define SvAMAGIC(sv)           (SvROK(sv) && (SvFLAGS(SvRV(sv)) & SVf_AMAGIC))
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+#  define SvAMAGIC_on(sv)      ({ SV *kloink = sv;                     \
+                                  assert(SvROK(kloink));               \
+                                  SvFLAGS(SvRV(kloink)) |= SVf_AMAGIC; \
+                               })
+#  define SvAMAGIC_off(sv)     ({ SV *kloink = sv;                     \
+                                  if(SvROK(kloink))                    \
+                                       SvFLAGS(SvRV(kloink)) &= ~SVf_AMAGIC;\
+                               })
+#else
+#  define SvAMAGIC_on(sv)      (SvFLAGS(SvRV(sv)) |= SVf_AMAGIC)
+#  define SvAMAGIC_off(sv)     (SvROK(sv) && SvFLAGS(SvRV(sv)) &= ~SVf_AMAGIC)
+#endif
 
-#define SvGAMAGIC(sv)           (SvFLAGS(sv) & (SVs_GMG|SVf_AMAGIC))
+#define SvGAMAGIC(sv)           (SvGMAGICAL(sv) || SvAMAGIC(sv))
 
 /*
 #define Gv_AMG(stash) \
@@ -1653,7 +1664,7 @@ Like C<sv_catsv> but doesn't process magic.
 
 #define CAN_COW_MASK   (SVs_OBJECT|SVs_GMG|SVs_SMG|SVs_RMG|SVf_IOK|SVf_NOK| \
                         SVf_POK|SVf_ROK|SVp_IOK|SVp_NOK|SVp_POK|SVf_FAKE| \
-                        SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_AMAGIC)
+                        SVf_OOK|SVf_BREAK|SVf_READONLY)
 #define CAN_COW_FLAGS  (SVp_POK|SVf_POK)
 
 #define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) \