Use new PERL_MAGIC_vstring abstraction API in Storable.xs

Author: leonerd

dist/Storable/Storable.xs

@@ -296,6 +296,28 @@ typedef STRLEN ntag_t;
 #define VSTRING_CROAK() CROAK(("Cannot retrieve vstring in this perl"))
 #endif
 
+#ifndef sv_vstring_get
+#define sv_vstring_get(sv,pvp,lenp) S_sv_vstring_get(aTHX_ sv,pvp,lenp)
+static bool S_sv_vstring_get(pTHX_ SV *sv, const char **pvp, STRLEN *lenp)
+{
+  MAGIC *mg;
+  if(!SvMAGICAL(sv) || !(mg = mg_find(sv, PERL_MAGIC_vstring)))
+    return FALSE;
+
+  *pvp  = mg->mg_ptr;
+  *lenp = mg->mg_len;
+  return TRUE;
+}
+#endif
+
+#ifndef sv_vstring_set
+#define sv_vstring_set(sv,pv,len) \
+  STMT_START {                                             \
+    sv_magic((sv), NULL, PERL_MAGIC_vstring, (pv), (len)); \
+    SvRMAGICAL_on(sv);                                     \
+  } STMT_END
+#endif
+
 #ifdef HvPLACEHOLDERS
 #define HAS_RESTRICTED_HASHES
 #else
@@ -2582,10 +2604,11 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
         TRACEME(("ok (double 0x%" UVxf ", value = %" NVff ")", PTR2UV(sv), nv.nv));
 
     } else if (flags & (SVp_POK | SVp_NOK | SVp_IOK)) {
+        UV wlen; /* For 64-bit machines */
 #ifdef SvVOK
-        MAGIC *mg;
+        const char *vstr_pv;
+        STRLEN vstr_len;
 #endif
-        UV wlen; /* For 64-bit machines */
 
     string_readlen:
         pv = SvPV(sv, len);
@@ -2597,18 +2620,16 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
     string:
 
 #ifdef SvVOK
-        if (SvMAGICAL(sv) && (mg = mg_find(sv, 'V'))) {
+        if (sv_vstring_get(sv, &vstr_pv, &vstr_len)) {
             /* The macro passes this by address, not value, and a lot of
                called code assumes that it's 32 bits without checking.  */
-            const SSize_t len = mg->mg_len;
             /* we no longer accept vstrings over I32_SIZE-1, so don't emit
                them, also, older Storables handle them badly.
             */
-            if (len >= I32_MAX) {
+            if (vstr_len >= I32_MAX) {
                 CROAK(("vstring too large to freeze"));
             }
-            STORE_PV_LEN((const char *)mg->mg_ptr,
-                         len, SX_VSTRING, SX_LVSTRING);
+            STORE_PV_LEN(vstr_pv, vstr_len, SX_VSTRING, SX_LVSTRING);
         }
 #endif
 
@@ -5825,9 +5846,7 @@ static SV *retrieve_vstring(pTHX_ stcxt_t *cxt, const char *cname)
     sv = retrieve(aTHX_ cxt, cname);
     if (!sv)
         return (SV *) 0;                /* Failed */
-    sv_magic(sv,NULL,PERL_MAGIC_vstring,s,len);
-    /* 5.10.0 and earlier seem to need this */
-    SvRMAGICAL_on(sv);
+    sv_vstring_set(sv, s, len);
 
     TRACEME(("ok (retrieve_vstring at 0x%" UVxf ")", PTR2UV(sv)));
     return sv;
@@ -5868,9 +5887,7 @@ static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname)
         Safefree(s);
         return (SV *) 0;                /* Failed */
     }
-    sv_magic(sv,NULL,PERL_MAGIC_vstring,s,len);
-    /* 5.10.0 and earlier seem to need this */
-    SvRMAGICAL_on(sv);
+    sv_vstring_set(sv, s, len);
 
     Safefree(s);
 

dist/Storable/lib/Storable.pm

@@ -30,7 +30,7 @@ our @EXPORT_OK = qw(
 our ($canonical, $forgive_me);
 
 BEGIN {
-    our $VERSION = '3.35';
+    our $VERSION = '3.36';
 }
 
 our $recursion_limit;