Bump Devel-PPPort and recover patches from repo

Apply to blead multiple patches only available on the D-PPP GitHub repo. * Bump INT_MAX_PERL to version 5038000 * Fix sv_2pv and sv_2pv_flags for Perl < 5.17.2 * Change github clone URL from git:// to https:// * Teach scanprov about --skip-devels * Use __REDEFINE__ in more parts/inc/misc locations Extra fixes after review: * Add link to GitHub issue for sv_2pv fix for Perl < 5.7.2 * Prefer using 'PERL_USE_GCC_BRACE_GROUPS' check instead of PERL_GCC_BRACE_GROUPS_FORBIDDEN * Stop using PL_na for sv_2pv_flags and sv_2pv_flags
Perl · Sep 12, 2023 · 91497b7 · 91497b7
1 parent 65cfe01
commit 91497b7
Show file tree

Hide file tree

Showing 9 changed files with 123 additions and 39 deletions.
diff --git a/dist/Devel-PPPort/HACKERS b/dist/Devel-PPPort/HACKERS
@@ -220,6 +220,22 @@ really needed for the public at large to know about, you should use
 instead.  To avoid name space conflicts, follow what's in L</Helper macros>,
 below.
 
+=item __REDEFINE__
+
+If you add the line C<__REDEFINE__> to the C<=provides> section, you can use
+lines like this in the C<=implementation> section:
+
+  __REDEFINE__ macro    some definition
+
+to both redefine C<macro> and indicate that it is provided by F<ppport.h>.  This
+replaces these C<=implementation> section lines:
+
+  #undef macro
+  #ifndef macro
+  #  define macro    some definition
+  #endif
+
+
 =item Helper macros
 
 If you need to define a helper macro which is not part of C<Devel::PPPort> API

diff --git a/dist/Devel-PPPort/Makefile.PL b/dist/Devel-PPPort/Makefile.PL
@@ -106,7 +106,7 @@ sub configure
         },
         repository => {
           type => 'git',
-          url  => 'git://github.com/Dual-Life/Devel-PPPort.git',
+          url  => 'https://github.com/Dual-Life/Devel-PPPort.git',
           web  => 'https://github.com/Dual-Life/Devel-PPPort',
         },
       },

diff --git a/dist/Devel-PPPort/PPPort_pm.PL b/dist/Devel-PPPort/PPPort_pm.PL
@@ -124,7 +124,7 @@ my @todo_list = reverse sort keys %todo;
 # directories are empty (which should only happen during regeneration of the
 # base and todo files).).  Actually the final element is for blead (at the
 # time things were regenerated), which is 1 beyond the max version supported.
-my $INT_MAX_PERL = (@todo_list) ? $todo_list[0] - 1 : '5034000'; # used for __MAX_PERL__
+my $INT_MAX_PERL = (@todo_list) ? $todo_list[0] - 1 : '5038000'; # used for __MAX_PERL__
 my $MAX_PERL = format_version($INT_MAX_PERL);
 my $INT_MIN_PERL = (@todo_list) ? $todo_list[-1] : 5003007;
 my $MIN_PERL = format_version($INT_MIN_PERL);
@@ -756,7 +756,7 @@ package Devel::PPPort;
 use strict;
 use vars qw($VERSION $data);
 
-$VERSION = '3.71';
+$VERSION = '3.72';
 
 sub _init_data
 {

diff --git a/dist/Devel-PPPort/devel/devtools.pl b/dist/Devel-PPPort/devel/devtools.pl
@@ -148,6 +148,14 @@ sub eta
   return sprintf "%02d:%02d:%02d", $h, $m, $s;
 }
 
+# Devel releases are odd numbered ones 5.6 and above, but use every
+# release for below 5.6
+sub is_devel_release ($) {
+    my (undef, $major, $minor) = parse_version(shift);
+    return $major >= 6 && $major % 2 != 0;
+}
+
+
 sub get_and_sort_perls($)
 {
     my $opt = shift;
@@ -180,12 +188,8 @@ ($)
         $version = format_version($version);
 
         if ($skip_devels) {
-            my ($super, $major, $minor) = parse_version($version);
-
             # If skipping development releases, we still use blead (0th entry).
-            # Devel releases are odd numbered ones 5.6 and above, but use every
-            # release for below 5.6
-            if ($i != 0 && $major >= 6 && $major % 2 != 0) {
+            if ($i != 0 && is_devel_release($version)) {
                 splice @perls, $i, 1;
                 last if $i >= @perls;
                 redo;

diff --git a/dist/Devel-PPPort/devel/scanprov b/dist/Devel-PPPort/devel/scanprov
@@ -62,7 +62,10 @@ our %opt = (
  'debug-start' => "",
 );
 
-GetOptions(\%opt, qw( install=s mode=s blead=s debug=i debug-start=s)) or die;
+GetOptions(\%opt, qw( install=s mode=s
+                      blead=s debug=i
+                      debug-start=s
+                      skip-devels)) or die;
 
 my $clean = $opt{mode} eq 'clean';
 my $write = $clean || $opt{mode} eq 'write';
@@ -166,6 +169,12 @@ if ($write) {
 
     # Only a few files will have exceptions that apply to them.  Rewrite each
     foreach my $version (keys %add_by_version) {
+        if (is_devel_release($version)) {
+            my ($super, $major, $minor) = parse_version($version);
+            $major++;   # Go to next highest version that isn't a devel
+            $version = "$super.$major.0";
+        }
+
         my $file = "$todo_dir/" . int_parse_version($version);
         print "-- Adding known exceptions to $file --\n";
         open my $fh, "+<", $file or die "$file: $!\n";

diff --git a/dist/Devel-PPPort/parts/inc/SvPV b/dist/Devel-PPPort/parts/inc/SvPV
@@ -14,6 +14,7 @@
 __UNDEFINED__
 SvPVbyte
 sv_2pvbyte
+sv_2pv
 sv_2pv_flags
 sv_pvn_force_flags
 
@@ -82,14 +83,50 @@ __UNDEFINED__  SV_SMAGIC                0
 __UNDEFINED__  SV_HAS_TRAILING_NUL      0
 __UNDEFINED__  SV_COW_SHARED_HASH_KEYS  0
 
+#if { VERSION < 5.7.2 }
+#
+/* Fix sv_2pv for Perl < 5.7.2 - view https://github.com/Dual-Life/Devel-PPPort/issues/231 */
+
+# ifdef sv_2pv
+#  undef sv_2pv
+# endif
+
+# if defined(PERL_USE_GCC_BRACE_GROUPS)
+  __UNDEFINED__ sv_2pv(sv, lp) ({ SV *_sv_2pv = (sv); STRLEN sv_2pv_dummy_; STRLEN *_lp_2pv = (lp); _lp_2pv = _lp_2pv ? : &sv_2pv_dummy_; SvPOKp(_sv_2pv) ? ((*(_lp_2pv) = SvCUR(_sv_2pv)), SvPVX(_sv_2pv)) : Perl_sv_2pv(aTHX_ _sv_2pv, (_lp_2pv)); })
+# else
+  __UNDEFINED__ sv_2pv(sv, lp) (SvPOKp(sv) ? ((*((lp) ? (lp) : &PL_na) = SvCUR(sv)), SvPVX(sv)) : Perl_sv_2pv(aTHX_ (sv), (lp)))
+# endif
+
+#endif
+
+#if { VERSION < 5.7.2 }
+
+/* Define sv_2pv_flags for Perl < 5.7.2 which does not have it at all */
+
 #if defined(PERL_USE_GCC_BRACE_GROUPS)
-  __UNDEFINED__ sv_2pv_flags(sv, lp, flags) ({ SV *_sv = (sv); const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &PL_na; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_2pv(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_2pv(_sv, _lp); })
-  __UNDEFINED__ sv_pvn_force_flags(sv, lp, flags) ({ SV *_sv = (sv); const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &PL_na; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_pvn_force(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_pvn_force(_sv, _lp); })
+  __UNDEFINED__ sv_2pv_flags(sv, lp, flags) ({ SV *_sv = (sv); STRLEN sv_2pv_dummy_; const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &sv_2pv_dummy_; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_2pv(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_2pv(_sv, _lp); })
+  __UNDEFINED__ sv_pvn_force_flags(sv, lp, flags) ({ SV *_sv = (sv); STRLEN sv_2pv_dummy_; const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &sv_2pv_dummy_; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_pvn_force(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_pvn_force(_sv, _lp); })
 #else
   __UNDEFINED__ sv_2pv_flags(sv, lp, flags) ((PL_Sv = (sv)), (!((flags) & SV_GMAGIC) && SvGMAGICAL(PL_Sv)) ? (SvGMAGICAL_off(PL_Sv), (PL_Xpv = (XPV *)sv_2pv(PL_Sv, (lp) ? (lp) : &PL_na)), SvGMAGICAL_on(PL_Sv), (char *)PL_Xpv) : sv_2pv(PL_Sv, (lp) ? (lp) : &PL_na))
   __UNDEFINED__ sv_pvn_force_flags(sv, lp, flags) ((PL_Sv = (sv)), (!((flags) & SV_GMAGIC) && SvGMAGICAL(PL_Sv)) ? (SvGMAGICAL_off(PL_Sv), (PL_Xpv = (XPV *)sv_pvn_force(PL_Sv, (lp) ? (lp) : &PL_na)), SvGMAGICAL_on(PL_Sv), (char *)PL_Xpv) : sv_pvn_force(PL_Sv, (lp) ? (lp) : &PL_na))
 #endif
 
+#elif { VERSION < 5.17.2 }
+
+/* Fix sv_2pv_flags for Perl < 5.17.2 */
+
+# ifdef sv_2pv_flags
+#  undef sv_2pv_flags
+# endif
+
+# if defined(PERL_USE_GCC_BRACE_GROUPS)
+  __UNDEFINED__ sv_2pv_flags(sv, lp, flags) ({ SV *_sv_2pv = (sv); STRLEN sv_2pv_dummy_; const I32 _flags_2pv = (flags); STRLEN *_lp_2pv = (lp); _lp_2pv = _lp_2pv ? : &sv_2pv_dummy_; ((!(_flags_2pv & SV_GMAGIC) || !SvGMAGICAL(_sv_2pv)) && SvPOKp(_sv_2pv)) ? ((*(_lp_2pv) = SvCUR(_sv_2pv)), SvPVX(_sv_2pv)) : Perl_sv_2pv_flags(aTHX_ _sv_2pv, (_lp_2pv), (_flags_2pv)); })
+# else
+  __UNDEFINED__ sv_2pv_flags(sv, lp, flags) (((!((flags) & SV_GMAGIC) || !SvGMAGICAL(sv)) && SvPOKp(sv)) ? ((*((lp) ? (lp) : &PL_na) = SvCUR(sv)), SvPVX(sv)) : Perl_sv_2pv_flags(aTHX_ (sv), (lp), (flags)))
+# endif
+
+#endif
+
 #if { VERSION < 5.8.8 } || ( { VERSION >= 5.9.0 } && { VERSION < 5.9.3 } )
 # define D_PPP_SVPV_NOLEN_LP_ARG &PL_na
 #else
@@ -433,7 +470,20 @@ SvPVCLEAR(sv)
                 SvPVCLEAR(sv);
 
 
-=tests plan => 50
+SV *
+sv_2pv(sv)
+        SV *sv
+        PREINIT:
+                STRLEN len;
+                const char *str;
+        CODE:
+                str = sv_2pv(sv, &len);
+                RETVAL = newSVpvn(str, len);
+        OUTPUT:
+                RETVAL
+
+
+=tests plan => 53
 
 my $mhx = "mhx";
 
@@ -507,3 +557,7 @@ is($str, "x"x40);
 is($s2, "x"x40);
 ok($before > 41);
 is($after, 41);
+
+is(&Devel::PPPort::sv_2pv(42), "42");
+is(&Devel::PPPort::sv_2pv(0.15), "0.15");
+is(&Devel::PPPort::sv_2pv("string"), "string");
diff --git a/dist/Devel-PPPort/parts/inc/misc b/dist/Devel-PPPort/parts/inc/misc
@@ -12,6 +12,7 @@
 =provides
 
 __UNDEFINED__
+__REDEFINE__
 END_EXTERN_C
 EXTERN_C
 INT2PTR
@@ -229,8 +230,7 @@ __UNDEFINED__ SvRXOK(sv) (!!SvRX(sv))
 __UNDEFINED__  NOOP          /*EMPTY*/(void)0
 
 #if { VERSION < 5.6.1 } && { VERSION < 5.27.7 }
-#undef dNOOP
-__UNDEFINED__ dNOOP struct Perl___notused_struct
+__REDEFINE__ dNOOP struct Perl___notused_struct
 #endif
 
 #ifndef NVTYPE
@@ -270,17 +270,14 @@ __UNDEFINED__  PTR2IV(p)       INT2PTR(IV,p)
 __UNDEFINED__  PTR2UV(p)       INT2PTR(UV,p)
 __UNDEFINED__  PTR2NV(p)       NUM2PTR(NV,p)
 
-#undef START_EXTERN_C
-#undef END_EXTERN_C
-#undef EXTERN_C
 #ifdef __cplusplus
-#  define START_EXTERN_C extern "C" {
-#  define END_EXTERN_C }
-#  define EXTERN_C extern "C"
+__REDEFINE__ START_EXTERN_C extern "C" {
+__REDEFINE__ END_EXTERN_C }
+__REDEFINE__ EXTERN_C extern "C"
 #else
-#  define START_EXTERN_C
-#  define END_EXTERN_C
-#  define EXTERN_C extern
+__REDEFINE__ START_EXTERN_C
+__REDEFINE__ END_EXTERN_C
+__REDEFINE__ EXTERN_C extern
 #endif
 
 #if { VERSION < 5.004 } || defined(PERL_GCC_PEDANTIC)
@@ -297,14 +294,12 @@ __UNDEF_NOT_PROVIDED__  PERL_GCC_BRACE_GROUPS_FORBIDDEN
 #  endif
 #endif
 
-#undef STMT_START
-#undef STMT_END
 #if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
-#    define STMT_START  if (1)
-#    define STMT_END    else (void)0
+__REDEFINE__ STMT_START  if (1)
+__REDEFINE__ STMT_END    else (void)0
 #else
-#    define STMT_START  do
-#    define STMT_END    while (0)
+__REDEFINE__ STMT_START  do
+__REDEFINE__ STMT_END    while (0)
 #endif
 
 __UNDEFINED__  boolSV(b)    ((b) ? &PL_sv_yes : &PL_sv_no)
@@ -354,8 +349,7 @@ __UNDEFINED__  dAXMARK         I32 ax = POPMARK; \
 __UNDEFINED__  XSprePUSH       (sp = PL_stack_base + ax - 1)
 
 #if { VERSION < 5.005 }
-#  undef XSRETURN
-#  define XSRETURN(off)                                   \
+__REDEFINE__ XSRETURN(off)                                   \
       STMT_START {                                        \
           PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
           return;                                         \
@@ -845,8 +839,8 @@ __UNDEFINED__ isIDFIRST_utf8_safe(s,e)  D_PPP_IS_GENERIC_UTF8_SAFE(s, e, IDFIRST
 __UNDEFINED__ isLOWER_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, LOWER)
 __UNDEFINED__ isPRINT_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PRINT)
 
-#  undef isPSXSPC_utf8_safe   /* Use the modern definition */
-__UNDEFINED__ isPSXSPC_utf8_safe(s,e)   isSPACE_utf8_safe(s,e)
+/* Use the modern definition */
+__REDEFINE__ isPSXSPC_utf8_safe(s,e)   isSPACE_utf8_safe(s,e)
 
 __UNDEFINED__ isPUNCT_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, PUNCT)
 __UNDEFINED__ isSPACE_utf8_safe(s,e)    D_PPP_IS_GENERIC_UTF8_SAFE(s, e, SPACE)
@@ -918,8 +912,8 @@ __UNDEFINED__ isIDFIRST_LC_utf8_safe(s,e)  D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, I
 __UNDEFINED__ isLOWER_LC_utf8_safe(s,e)    D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, LOWER)
 __UNDEFINED__ isPRINT_LC_utf8_safe(s,e)    D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, PRINT)
 
-#  undef isPSXSPC_LC_utf8_safe   /* Use the modern definition */
-__UNDEFINED__ isPSXSPC_LC_utf8_safe(s,e)   isSPACE_LC_utf8_safe(s,e)
+/* Use the modern definition */
+__REDEFINE__ isPSXSPC_LC_utf8_safe(s,e)   isSPACE_LC_utf8_safe(s,e)
 
 __UNDEFINED__ isPUNCT_LC_utf8_safe(s,e)    D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, PUNCT)
 __UNDEFINED__ isSPACE_LC_utf8_safe(s,e)    D_PPP_IS_GENERIC_LC_UTF8_SAFE(s, e, SPACE)

diff --git a/dist/Devel-PPPort/parts/inc/version b/dist/Devel-PPPort/parts/inc/version
@@ -26,7 +26,7 @@ PERL_BCDVERSION
 
 =implementation
 
-#define D_PPP_RELEASE_DATE 1647561600 /* 2022-03-18 */
+#define D_PPP_RELEASE_DATE 1693785600 /* 2023-09-04 */
 
 #if ! defined(PERL_REVISION) && ! defined(PERL_VERSION_MAJOR)
 #  if   !   defined(__PATCHLEVEL_H_INCLUDED__)                                  \

diff --git a/dist/Devel-PPPort/parts/ppptools.pl b/dist/Devel-PPPort/parts/ppptools.pl
@@ -158,9 +158,16 @@ sub parse_partspec
         @tmp or warn "no matches for regex $p in $file\n";
         push @prov, do { my %h; grep !$h{$_}++, @tmp };
       }
-      elsif ($p eq '__UNDEFINED__') {
-        my @tmp = $data{implementation} =~ /^\s*__UNDEFINED__[^\r\n\S]+(\w+)/gm;
-        @tmp or warn "no __UNDEFINED__ macros in $file\n";
+      elsif ($p eq '__UNDEFINED__' || $p eq '__REDEFINE__') {
+
+        my @tmp = $data{implementation} =~ /^\s*$p[^\r\n\S]+(\w+)/gm;
+
+        if ( $p eq '__REDEFINE__' ) {
+          # relies on expand_undefined logic
+          $data{implementation} =~ s/^\s*__REDEFINE__[^\r\n\S]+(\w+)/#undef $1\n__UNDEFINED__ $1/gm;
+        }
+
+        @tmp or warn "no $p macros in $file\n";
         push @prov, @tmp;
       }
       else {