add the new vstring API to Devel::PPPort

MANIFEST

@@ -3838,6 +3838,7 @@ dist/Devel-PPPort/parts/base/5035007
 dist/Devel-PPPort/parts/base/5035008
 dist/Devel-PPPort/parts/base/5035009
 dist/Devel-PPPort/parts/base/5035010
+dist/Devel-PPPort/parts/base/5041010
 dist/Devel-PPPort/parts/embed.fnc		Devel::PPPort Perl API listing
 dist/Devel-PPPort/parts/inc/01_test		Devel::PPPort include
 dist/Devel-PPPort/parts/inc/call		Devel::PPPort include
@@ -4112,6 +4113,7 @@ dist/Devel-PPPort/parts/todo/5035007
 dist/Devel-PPPort/parts/todo/5035008
 dist/Devel-PPPort/parts/todo/5035009
 dist/Devel-PPPort/parts/todo/5035010
+dist/Devel-PPPort/parts/todo/5041010
 dist/Devel-PPPort/PPPort.xs			Devel::PPPort dummy PPPort.xs
 dist/Devel-PPPort/ppport_h.PL			Devel::PPPort ppport.h writer
 dist/Devel-PPPort/PPPort_pm.PL			Devel::PPPort PPPort.pm writer

Porting/test-dist-modules.pl

@@ -15,9 +15,11 @@
 my $continue;
 my $separate;
 my $install;
+my $keep;
 GetOptions("c|continue" => \$continue,
            "s|separate" => \$separate,
            "i|install"  => \$install,
+           "k|keep"     => \$keep,
            "h|help"     => \&usage)
   or usage("Unknown options");
 
@@ -119,7 +121,9 @@ sub test_dist {
 
     print "::group::Testing $name\n" if $github_ci;
     print "*** Testing $name ***\n";
-    my $dir = tempdir( CLEANUP => 1);
+    my $dir = tempdir( CLEANUP => !$keep);
+    print "$name testing in $dir\n" if $keep;
+
     run("cp", "-a", "dist/$name/.", "$dir/.")
       or die "Cannot copy dist files to working directory\n";
     chdir $dir

dist/Devel-PPPort/parts/base/5041010

@@ -0,0 +1,2 @@
+5.041010
+sv_vstring_get                 # U

dist/Devel-PPPort/parts/embed.fnc

@@ -1960,6 +1960,9 @@ Apd	|void	|sv_vcatpvfn_flags|NN SV *const sv|NN const char *const pat|const STRL
 Apd	|void	|sv_vsetpvfn	|NN SV *const sv|NN const char *const pat|const STRLEN patlen \
 				|NULLOK va_list *const args|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
 CpR	|NV	|str_to_version	|NN SV *sv
 Ap	|void	|regdump	|NN const regexp* r
 CiTop	|struct regexp *|ReANY	|NN const REGEXP * const re

dist/Devel-PPPort/parts/inc/magic

@@ -23,6 +23,9 @@ SvUV_nomg
 SvNV_nomg
 SvTRUE_nomg
 
+sv_vstring_get
+SvVSTRING
+
 =implementation
 
 #undef  SvGETMAGIC
@@ -254,10 +257,36 @@ sv_unmagicext(pTHX_ SV *const sv, const int type, const MGVTBL *vtbl)
 #endif
 #endif
 
+__UNDEFINED__ SvVSTRING(sv, len)  (sv_vstring_get(sv, &(len)))
+__UNDEFINED__ SvVOK(sv) (FALSE)
+
+#if !defined(sv_vstring_get)
+
+#if { NEED sv_vstring_get }
+
+const char *
+sv_vstring_get(pTHX_ SV *sv, STRLEN *lenp)
+{
+#ifdef SvVSTRING_mg
+    MAGIC *mg = SvVSTRING_mg(sv);
+    if (!mg) return NULL;
+
+    if (lenp) *lenp = mg->mg_len;
+    return mg->mg_ptr;
+#else
+    return NULL;
+#endif
+}
+
+#endif
+
+#endif
+
 =xsinit
 
 #define NEED_mg_findext
 #define NEED_sv_unmagicext
+#define NEED_sv_vstring_get
 
 #ifndef STATIC
 #define STATIC static
@@ -580,7 +609,26 @@ magic_SvPV_nomg_nolen(sv)
 
 #endif
 
-=tests plan => 63
+int
+SvVOK(sv)
+    SV *sv
+
+SV *
+SvVSTRING(sv)
+    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
+
+=tests plan => 64
 
 # Find proper magic
 ok(my $obj1 = Devel::PPPort->new_with_mg());
@@ -725,6 +773,18 @@ if (ivers($]) >= ivers("5.6")) {
 is tied($big)->{fetch}, 1;
 is tied($big)->{store}, 0;
 
+SKIP:
+{
+    my $vstr = eval "v1.23.456";
+
+    if (!Devel::PPPort::SvVOK($vstr)) {
+        skip "No vstring magic", 1;
+        last SKIP; # testutil skip() doesn't "last SKIP"
+    }
+
+    is Devel::PPPort::SvVSTRING($vstr), "v1.23.456", 'SvVSTRING()';
+}
+
 package TieScalarCounter;
 
 sub TIESCALAR {

dist/Devel-PPPort/parts/inc/ppphtest

@@ -728,11 +728,14 @@ for (@o) {
 ok(@o > 100);
 is($fail, 0);
 
-ok(exists $p{utf8_distance});
-is($p{utf8_distance}, '5.6.0');
-
-ok(exists $p{save_generic_svref});
-is($p{save_generic_svref}, '5.005_03');
+ok(exists $p{utf8_distance},
+   "found API utf8_distance");
+is($p{utf8_distance}, '5.6.0',
+   "utf8_distance introduced in 5.6.0");
+
+ok(exists $p{save_generic_svref}, "found API save_generic_svref");
+is($p{save_generic_svref}, '5.005_03',
+   "save_generic_svref introduced in 5.005_03");
 
 ===============================================================================
 

dist/Devel-PPPort/parts/todo/5041010

@@ -0,0 +1,2 @@
+5.041010
+

dist/Storable/Storable.xs

@@ -22,6 +22,7 @@
 #define NEED_newCONSTSUB
 #define NEED_newSVpvn_flags
 #define NEED_newRV_noinc
+#define NEED_sv_vstring_get
 #include "ppport.h"             /* handle old perls */
 
 #ifdef DEBUGGING
@@ -296,23 +297,6 @@ 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

dist/Storable/lib/Storable.pm

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