From 3d954bd3df48df30553cea959052ebde6e8e5391 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 27 Mar 2025 10:59:04 +1100 Subject: [PATCH 1/5] Devel-PPPort: improve ppptest test reporting A change I made caused this to fail, tracking it down was rough. --- dist/Devel-PPPort/parts/inc/ppphtest | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) 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"); =============================================================================== From bb2456542f8b4e96ee5afe577377c562a5857064 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 27 Mar 2025 10:59:59 +1100 Subject: [PATCH 2/5] test-dist-modules.pl: allow the invoker to keep the build around This is especially handy when tracking down problems with Devel::PPPort, since so much is generated. --- Porting/test-dist-modules.pl | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) 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 From 2f32b3b369fcbd5f1366dde598d9f100e54b7391 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 27 Mar 2025 11:21:07 +1100 Subject: [PATCH 3/5] Devel-PPPort: add SvVSTRING() vstrings were originally added in perl-5.8.0-82-g92f0c26562, SvVSTRING_mg() was originally added in perl-5.8.0-8018-gb0a11fe104 so technically in the same release. I expect there were some uses of intermediate versions 19 years ago, but I don't think we need to worry about it now. --- dist/Devel-PPPort/parts/embed.fnc | 3 ++ dist/Devel-PPPort/parts/inc/magic | 62 ++++++++++++++++++++++++++++++- 2 files changed, 64 insertions(+), 1 deletion(-) 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 { From 97a762d5d4c709cf7230724f444b65b4c9fee1d9 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 27 Mar 2025 11:24:31 +1100 Subject: [PATCH 4/5] Storable: use SvVSTRING() from ppport.h --- dist/Storable/Storable.xs | 18 +----------------- dist/Storable/lib/Storable.pm | 2 +- 2 files changed, 2 insertions(+), 18 deletions(-) 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; From 0a223ec7933e38ce5568586f78918baeb6431c2e Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 1 Apr 2025 10:53:33 +1100 Subject: [PATCH 5/5] Devel::PPPort: add compatibility entries for the new vstrings Based on @leont's comment on #23160. This seems to produce reasonable results: tony@venus:.../git/perl6$ cat foo.c SvVSTRING tony@venus:.../git/perl6$ ./perl -Ilib dist/Devel-PPPort/ppport.h --nofilter foo.c Scanning foo.c ... === Analyzing foo.c === Uses SvVSTRING, which depends on sv_vstring_get, SvVSTRING_mg, mg_find, PERL_MAGIC_vstring, SvMAGICAL File needs sv_vstring_get, adding static request Needs to include 'ppport.h' Analysis completed Suggested changes: --- foo.c 2025-04-01 10:51:39.040415623 +1100 +++ foo.c.patched 2025-04-01 10:55:11.347014468 +1100 @@ -1 +1,3 @@ +#define NEED_sv_vstring_get +#include "ppport.h" SvVSTRING --- MANIFEST | 2 ++ dist/Devel-PPPort/parts/base/5041010 | 2 ++ dist/Devel-PPPort/parts/todo/5041010 | 2 ++ 3 files changed, 6 insertions(+) create mode 100644 dist/Devel-PPPort/parts/base/5041010 create mode 100644 dist/Devel-PPPort/parts/todo/5041010 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/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/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 +