Add sv_vstring_get() API function and SvVSTRING() wrapper macro

This new function and wrapper macro mean that caller code does not have
to directly rely on (or be aware of) the `PERL_MAGIC_vstring` type. The
intent of the API now works independently of the current implemention as
magic.

Author: leonerd

MANIFEST

@@ -5217,6 +5217,7 @@ ext/XS-APItest/t/utf8_warn08.t			Tests for code in utf8.c
 ext/XS-APItest/t/utf8_warn09.t			Tests for code in utf8.c
 ext/XS-APItest/t/utf8_warn_base.pl		Tests for code in utf8.c
 ext/XS-APItest/t/valid_identifier.t		XS::APItest: tests for valid_identifier_sv()
+ext/XS-APItest/t/vstring.t			XS::APItest: tests for sv_vstring_*() API
 ext/XS-APItest/t/weaken.t			XS::APItest: tests for sv_rvweaken() and sv_get_backrefs()
 ext/XS-APItest/t/whichsig.t			XS::APItest: tests for whichsig() and variants
 ext/XS-APItest/t/win32.t			Test Win32 specific APIs

dist/Storable/Storable.xs

@@ -296,6 +296,23 @@ typedef STRLEN ntag_t;
 #define VSTRING_CROAK() CROAK(("Cannot retrieve vstring in this perl"))
 #endif
 
+#ifndef sv_vstring_get
+#define sv_vstring_get(sv,lenp) S_sv_vstring_get(aTHX_ sv,lenp)
+static const char *S_sv_vstring_get(pTHX_ SV *sv, STRLEN *lenp)
+{
+  MAGIC *mg;
+  if(!SvMAGICAL(sv) || !(mg = mg_find(sv, PERL_MAGIC_vstring)))
+    return NULL;
+
+  *lenp = mg->mg_len;
+  return mg->mg_ptr;
+}
+#endif
+
+#ifndef SvVSTRING
+#define SvVSTRING(sv,len)  (sv_vstring_get(sv, &(len)))
+#endif
+
 #ifdef HvPLACEHOLDERS
 #define HAS_RESTRICTED_HASHES
 #else
@@ -2583,7 +2600,8 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
 
     } else if (flags & (SVp_POK | SVp_NOK | SVp_IOK)) {
 #ifdef SvVOK
-        MAGIC *mg;
+        const char *vstr_pv;
+        STRLEN vstr_len;
 #endif
         UV wlen; /* For 64-bit machines */
 
@@ -2597,18 +2615,16 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
     string:
 
 #ifdef SvVOK
-        if (SvMAGICAL(sv) && (mg = mg_find(sv, 'V'))) {
+        if ((vstr_pv = SvVSTRING(sv, 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
 

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;

embed.fnc

@@ -3602,6 +3602,9 @@ Adp	|void	|sv_vsetpvfn	|NN SV * const sv			\
 				|NULLOK SV ** const svargs		\
 				|const Size_t sv_count			\
 				|NULLOK bool * const maybe_tainted
+Adp	|const char *|sv_vstring_get					\
+				|NN SV * const sv			\
+				|NULLOK STRLEN *lenp
 Cipx	|void	|switch_argstack|NN AV *to
 Adp	|void	|switch_to_global_locale
 Adp	|bool	|sync_locale

embed.h

@@ -849,6 +849,7 @@
 # define sv_vsetpvf(a,b,c)                      Perl_sv_vsetpvf(aTHX_ a,b,c)
 # define sv_vsetpvf_mg(a,b,c)                   Perl_sv_vsetpvf_mg(aTHX_ a,b,c)
 # define sv_vsetpvfn(a,b,c,d,e,f,g)             Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g)
+# define sv_vstring_get(a,b)                    Perl_sv_vstring_get(aTHX_ a,b)
 # define switch_argstack(a)                     Perl_switch_argstack(aTHX_ a)
 # define switch_to_global_locale()              Perl_switch_to_global_locale(aTHX)
 # define sync_locale()                          Perl_sync_locale(aTHX)

ext/XS-APItest/APItest.xs

@@ -8200,3 +8200,22 @@ get_savestack_ix()
         RETVAL = PL_savestack_ix;
     OUTPUT:
         RETVAL
+
+MODULE = XS::APItest            PACKAGE = XS::APItest::vstring
+
+bool
+SvVOK(SV *sv)
+
+SV *
+SvVSTRING(SV *sv)
+    CODE:
+    {
+        const char *vstr_pv;
+        STRLEN vstr_len;
+        if((vstr_pv = SvVSTRING(sv, vstr_len)))
+            RETVAL = newSVpvn(vstr_pv, vstr_len);
+        else
+            RETVAL = &PL_sv_undef;
+    }
+    OUTPUT:
+        RETVAL

ext/XS-APItest/t/vstring.t

@@ -0,0 +1,10 @@
+#!perl
+
+use Test::More tests => 2;
+use XS::APItest;
+
+{
+    my $vstr = v1.23.456;
+    ok SvVOK($vstr), '$vstr has SvVOK';
+    is SvVSTRING($vstr), "v1.23.456", 'SvVSTRING()';
+}

proto.h

@@ -4741,10 +4741,10 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
         }
         SvFLAGS(dsv) |= sflags & (SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK|SVf_UTF8);
         {
-            const MAGIC * const smg = SvVSTRING_mg(ssv);
-            if (smg) {
-                sv_magic(dsv, NULL, PERL_MAGIC_vstring,
-                         smg->mg_ptr, smg->mg_len);
+            const char *vstr_pv;
+            STRLEN vstr_len;
+            if ((vstr_pv = SvVSTRING(ssv, vstr_len))) {
+                sv_magic(dsv, NULL, PERL_MAGIC_vstring, vstr_pv, vstr_len);
                 SvRMAGICAL_on(dsv);
             }
         }
@@ -17891,6 +17891,34 @@ Perl_sv_regex_global_pos_clear(pTHX_ SV *sv)
         mg->mg_len = -1;
 }
 
+/*
+=for apidoc sv_vstring_get
+
+If the given SV has vstring magic, stores the length of it into the variable
+addressed by C<lenp>, and returns the string pointer.  If not, returns
+C<NULL>.
+
+If a pointer is returned to the caller, it will point to memory owned by the
+SV itself.  The caller is not responsible for freeing it after this call,
+though it will not remain valid for longer than the lifetime of the SV itself.
+The caller should take a copy of it if it needs to be accessed after this
+time.
+
+=cut
+*/
+
+const char *
+Perl_sv_vstring_get(pTHX_ SV * const sv, STRLEN *lenp)
+{
+    PERL_ARGS_ASSERT_SV_VSTRING_GET;
+
+    MAGIC *mg = SvVSTRING_mg(sv);
+    if(!mg) return NULL;
+
+    if(lenp) *lenp = mg->mg_len;
+    return mg->mg_ptr;
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */

sv.c

@@ -2843,6 +2843,21 @@ Create a new IO, setting the reference count to 1.
 #  define gv_dup_inc(s,t)	MUTABLE_GV(sv_dup_inc((const SV *)s,t))
 #endif
 
+/*
+=for apidoc    Am|const char *|SvVSTRING       |SV* sv|STRLEN len
+
+If the given SV has vstring magic, stores the length of it into the variable
+C<len>, and returns the string pointer.  If not, returns C<NULL>.
+
+This is a wrapper around the C<sv_vstring_get> function that conveniently
+takes the address of the C<len> variable, in a form similar to the C<SvPV>
+macro family.
+
+=cut
+*/
+
+#define SvVSTRING(sv, len)  (sv_vstring_get(sv, &(len)))
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */