diff --git a/MANIFEST b/MANIFEST index a6561fd2b890..7db1f4610f26 100644 --- a/MANIFEST +++ b/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 diff --git a/Porting/test-dist-modules.pl b/Porting/test-dist-modules.pl index d6a04c002055..d5529dc1bb11 100644 --- a/Porting/test-dist-modules.pl +++ b/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 diff --git a/dist/Devel-PPPort/parts/base/5041010 b/dist/Devel-PPPort/parts/base/5041010 new file mode 100644 index 000000000000..ffd232bed804 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5041010 @@ -0,0 +1,2 @@ +5.041010 +sv_vstring_get # U diff --git a/dist/Devel-PPPort/parts/embed.fnc b/dist/Devel-PPPort/parts/embed.fnc index e4b9a31259cd..6d16e486143b 100644 --- a/dist/Devel-PPPort/parts/embed.fnc +++ b/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 diff --git a/dist/Devel-PPPort/parts/inc/magic b/dist/Devel-PPPort/parts/inc/magic index 4772ab3c4def..7daa2f692eff 100644 --- a/dist/Devel-PPPort/parts/inc/magic +++ b/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 { diff --git a/dist/Devel-PPPort/parts/inc/ppphtest b/dist/Devel-PPPort/parts/inc/ppphtest index 26961a6956f6..9abb694ee802 100644 --- a/dist/Devel-PPPort/parts/inc/ppphtest +++ b/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"); =============================================================================== diff --git a/dist/Devel-PPPort/parts/todo/5041010 b/dist/Devel-PPPort/parts/todo/5041010 new file mode 100644 index 000000000000..f4f04d6bb35c --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5041010 @@ -0,0 +1,2 @@ +5.041010 + diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index a2694674dc7c..3930db6d01ae 100644 --- a/dist/Storable/Storable.xs +++ b/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 diff --git a/dist/Storable/lib/Storable.pm b/dist/Storable/lib/Storable.pm index e33c20d1bb6c..dce9843a42c8 100644 --- a/dist/Storable/lib/Storable.pm +++ b/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;