add SV_SKIP_OVERLOAD flag to sv_2*v_flags fns
authorDavid Mitchell <davem@iabyn.com>
Sat, 8 May 2010 16:23:56 +0000 (17:23 +0100)
committerDavid Mitchell <davem@iabyn.com>
Sat, 8 May 2010 20:28:27 +0000 (21:28 +0100)
While trying to coerce an SV into a string or whatever, stop if you
suddenly discover it's overloaded (this may not happen until after you've
called it's get magic)

sv.c
sv.h

diff --git a/sv.c b/sv.c
index 5ac2730..8cbd3a0 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2322,7 +2322,10 @@ Perl_sv_2iv_flags(pTHX_ register SV *const sv, const I32 flags)
        if (SvROK(sv)) {
        return_rok:
            if (SvAMAGIC(sv)) {
-               SV * const tmpstr=AMG_CALLun(sv,numer);
+               SV * tmpstr;
+               if (flags & SV_SKIP_OVERLOAD)
+                   return 0;
+               tmpstr=AMG_CALLun(sv,numer);
                if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
                    return SvIV(tmpstr);
                }
@@ -2398,7 +2401,10 @@ Perl_sv_2uv_flags(pTHX_ register SV *const sv, const I32 flags)
        if (SvROK(sv)) {
        return_rok:
            if (SvAMAGIC(sv)) {
-               SV *const tmpstr = AMG_CALLun(sv,numer);
+               SV *tmpstr;
+               if (flags & SV_SKIP_OVERLOAD)
+                   return 0;
+               tmpstr = AMG_CALLun(sv,numer);
                if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
                    return SvUV(tmpstr);
                }
@@ -2469,7 +2475,10 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags)
        if (SvROK(sv)) {
        return_rok:
            if (SvAMAGIC(sv)) {
-               SV *const tmpstr = AMG_CALLun(sv,numer);
+               SV *tmpstr;
+               if (flags & SV_SKIP_OVERLOAD)
+                   return 0;
+               tmpstr = AMG_CALLun(sv,numer);
                 if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
                    return SvNV(tmpstr);
                }
@@ -2786,7 +2795,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *const sv, STRLEN *const lp, const I32 flags
        if (SvROK(sv)) {
        return_rok:
             if (SvAMAGIC(sv)) {
-               SV *const tmpstr = AMG_CALLun(sv,string);
+               SV *tmpstr;
+               if (flags & SV_SKIP_OVERLOAD)
+                   return NULL;
+               tmpstr = AMG_CALLun(sv,string);
                if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
                    /* Unwrap this:  */
                    /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
diff --git a/sv.h b/sv.h
index 807b482..7d3f1a6 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -1694,6 +1694,9 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv>
  * This is used when the caller has already determined it is, and avoids
  * redundant work */
 #define SV_FORCE_UTF8_UPGRADE  4096
+/* if (after resolving magic etc), the SV is found to be overloaded,
+ * don't call the overload magic, just return as-is */
+#define SV_SKIP_OVERLOAD       8192
 
 /* The core is safe for this COW optimisation. XS code on CPAN may not be.
    So only default to doing the COW setup if we're in the core.