Define new API for accessing PERL_MAGIC_vstring

Adds two new API functions to abstract out applying or querying the
`PERL_MAGIC_vstring` annotation, used to create vstring values. Code can
now use these API functions without needing to be aware of the inner
details involved in how the magic currently works.

Author: leonerd

MANIFEST

@@ -5216,6 +5216,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

embed.fnc

@@ -3600,6 +3600,12 @@ Adp	|void	|sv_vsetpvfn	|NN SV * const sv			\
 				|NULLOK SV ** const svargs		\
 				|const Size_t sv_count			\
 				|NULLOK bool * const maybe_tainted
+Adp	|bool	|sv_vstring_get |NN SV * const sv			\
+				|NULLOK const char **pvp		\
+				|NULLOK STRLEN *lenp
+Adp	|void	|sv_vstring_set |NN SV * const sv			\
+				|NN const char *pv			\
+				|STRLEN const len
 Cipx	|void	|switch_argstack|NN AV *to
 Adp	|void	|switch_to_global_locale
 Adp	|bool	|sync_locale

embed.h

@@ -848,6 +848,8 @@
 # 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,c)                  Perl_sv_vstring_get(aTHX_ a,b,c)
+# define sv_vstring_set(a,b,c)                  Perl_sv_vstring_set(aTHX_ a,b,c)
 # 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,31 @@ get_savestack_ix()
         RETVAL = PL_savestack_ix;
     OUTPUT:
         RETVAL
+
+MODULE = XS::APItest            PACKAGE = XS::APItest::vstring
+
+bool
+SvVOK(SV *sv)
+
+SV *
+sv_vstring_get(SV *sv)
+    CODE:
+    {
+        const char *vstr_pv;
+        STRLEN vstr_len;
+        if(sv_vstring_get(sv, &vstr_pv, &vstr_len))
+            RETVAL = newSVpvn(vstr_pv, vstr_len);
+        else
+            RETVAL = &PL_sv_undef;
+    }
+    OUTPUT:
+        RETVAL
+
+void
+sv_vstring_set(SV *sv, SV *newstr)
+    CODE:
+    {
+        STRLEN len;
+        const char *pv = SvPV(newstr, len);
+        sv_vstring_set(sv, pv, len);
+    }

ext/XS-APItest/t/vstring.t

@@ -0,0 +1,20 @@
+#!perl
+
+use Test::More tests => 5;
+use XS::APItest;
+
+{
+    my $vstr = v1.23.456;
+    ok SvVOK($vstr), '$vstr has SvVOK';
+    is sv_vstring_get($vstr), "v1.23.456", 'sv_vstring_get()';
+}
+
+{
+    my $sv = "plain";
+    sv_vstring_set($sv, "v7.89");
+    ok SvVOK($sv), '$sv has SvVOK after sv_vstring_set()';
+    is sv_vstring_get($sv), "v7.89", '$sv has stored vstring';
+
+    sv_vstring_set($sv, "v9.87");
+    is sv_vstring_get($sv), "v9.87", 'sv_vstring_set() can update stored vstring';
+}

pod/perldelta.pod

@@ -363,6 +363,14 @@ API functions avoids XS modules needing to know about or interact directly
 with the way this position is currently stored, which involves the
 C<PERL_MAGIC_regex_global> magic type.
 
+=item *
+
+Two new API functions have been added to interact with SVs that behave as
+vstrings.  These are C<sv_vstring_get()> and C<sv_vstring_set()>.  Using
+these API functions avoids XS modules needing to know about or interact
+directly with the way this information is currently stored, which involves
+the C<PERL_MAGIC_vstring> magic type.
+
 =back
 
 =head1 Selected Bug Fixes

proto.h

@@ -4730,12 +4730,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);
-                SvRMAGICAL_on(dsv);
-            }
+            const char *vstr_pv;
+            STRLEN vstr_len;
+            if (sv_vstring_get(ssv, &vstr_pv, &vstr_len))
+                sv_vstring_set(dsv, vstr_pv, vstr_len);
         }
     }
     else if (sflags & (SVp_IOK|SVp_NOK)) {
@@ -17878,6 +17876,64 @@ 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 string pointer and length into
+the variables addressed by C<pvp> and C<lenp>, and returns true.  If not,
+returns false.
+
+If a pointer is returned to the caller in the C<pvp> variable, 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
+*/
+
+bool
+Perl_sv_vstring_get(pTHX_ SV * const sv, const char **pvp, STRLEN *lenp)
+{
+    PERL_ARGS_ASSERT_SV_VSTRING_GET;
+
+    MAGIC *mg = SvVSTRING_mg(sv);
+    if(!mg) return false;
+
+    if(pvp)  *pvp  = mg->mg_ptr;
+    if(lenp) *lenp = mg->mg_len;
+    return true;
+}
+
+/*
+=for apidoc sv_vstring_set
+
+Applies vstring magic to the given SV, storing the string given by C<pv> for
+C<len> bytes into it.  If the SV already had vstring magic, the previous
+stored string is freed and replaced.
+
+=cut
+*/
+
+void
+Perl_sv_vstring_set(pTHX_ SV * const sv, const char *pv, STRLEN const len)
+{
+    PERL_ARGS_ASSERT_SV_VSTRING_SET;
+
+    MAGIC *mg;
+    if((mg = SvVSTRING_mg(sv))) {
+        char *was_ptr = mg->mg_ptr;
+        mg->mg_ptr = savepvn(pv, len);
+        mg->mg_len = len;
+
+        Safefree(was_ptr);
+    }
+    else {
+        sv_magic(sv, NULL, PERL_MAGIC_vstring, pv, len);
+        SvRMAGICAL_on(sv);
+    }
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */

sv.c

@@ -13353,8 +13353,7 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
                  pos++;
         }
         SvPOK_on(sv);
-        sv_magic(sv,NULL,PERL_MAGIC_vstring,(const char*)start, pos-start);
-        SvRMAGICAL_on(sv);
+        sv_vstring_set(sv, start, pos-start);
     }
     return (char *)s;
 }