ppport.h makes bad suggestions for dist/ modules

[toddr]

I'm reporting this here per the request of @khwilliamson and @atoomic.

I audited the perl ppport.h recommendations for all of our dist modules and have submitted pull requests where the recommendation works ok on blead. However, it made some bad suggestions which @khwilliamson indicated might be bugs in need of investigation. I'm going to provide those recommendations here for review.

Submitted fixes are:

• Update IO.xs to conform to ppport.h 3.68 recommendations #19627
• Update Dumper.xs to conform to ppport.h 3.68 recommendations #19628
• Update Storable.xs to conform to ppport.h 3.68 recommendations #19629
• Update Time-HiRes.xs to conform to ppport.h 3.68 recommendations #19630
• Update Unicode-Normalize.xs to conform to ppport.h 3.68 recommendations #19631

[toddr]

Suggested changes:
--- Devel-PPPort/RealPPPort.xs
+++ Devel-PPPort/RealPPPort.xs.patched
@@ -34,6 +34,9 @@
 /* ========== BEGIN XSINIT ================================================== */
 
 /* ---- code from parts/inc/call ---- */
+#define NEED_mess
+#define NEED_mess_nocontext
+#define NEED_vmess
 #define NEED_eval_pv
 #define NEED_load_module
 #define NEED_vload_module
@@ -771,9 +774,9 @@
                 RETVAL
 
 I32
-G_ARRAY()
+G_LIST()
         CODE:
-                RETVAL = G_ARRAY;
+                RETVAL = G_LIST;
         OUTPUT:
                 RETVAL
 
@@ -1069,20 +1072,20 @@
                 RETVAL
 
 UV
-Perl_grok_number(string)
+grok_number(string)
         SV *string
         PREINIT:
                 const char *pv;
                 STRLEN len;
         CODE:
                 pv = SvPV(string, len);
-                if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
+                if (!grok_number(pv, len, &RETVAL))
                   XSRETURN_UNDEF;
         OUTPUT:
                 RETVAL
 
 UV
-Perl_grok_bin(string)
+grok_bin(string)
         SV *string
         PREINIT:
                 char *pv;
@@ -1090,12 +1093,12 @@
                 STRLEN len;
         CODE:
                 pv = SvPV(string, len);
-                RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
+                RETVAL = grok_bin(pv, &len, &flags, NULL);
         OUTPUT:
                 RETVAL
 
 UV
-Perl_grok_hex(string)
+grok_hex(string)
         SV *string
         PREINIT:
                 char *pv;
@@ -1103,12 +1106,12 @@
                 STRLEN len;
         CODE:
                 pv = SvPV(string, len);
-                RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
+                RETVAL = grok_hex(pv, &len, &flags, NULL);
         OUTPUT:
                 RETVAL
 
 UV
-Perl_grok_oct(string)
+grok_oct(string)
         SV *string
         PREINIT:
                 char *pv;
@@ -1116,7 +1119,7 @@
                 STRLEN len;
         CODE:
                 pv = SvPV(string, len);
-                RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
+                RETVAL = grok_oct(pv, &len, &flags, NULL);
         OUTPUT:
                 RETVAL
 
@@ -1702,11 +1705,11 @@
 #if (PERL_BCDVERSION >= 0x5004000)
 
 SV *
-mess_sv(sv, consume)
+PL_mess_sv(sv, consume)
     SV *sv
     bool consume
 CODE:
-    RETVAL = newSVsv(mess_sv(sv, consume));
+    RETVAL = newSVsv(PL_mess_sv(sv, consume));
 OUTPUT:
     RETVAL
 
@@ -3531,7 +3534,7 @@
 #endif
 
 void
-Perl_sv_catpvf_mg(sv)
+Perl_sv_catpvf_mg(aTHX_ sv)
         SV *sv
         CODE:
 #if (PERL_BCDVERSION >= 0x5004000)
@@ -3559,7 +3562,7 @@
 #endif
 
 void
-Perl_sv_setpvf_mg(sv)
+Perl_sv_setpvf_mg(aTHX_ sv)
         SV *sv
         CODE:
 #if (PERL_BCDVERSION >= 0x5004000)
@@ -4058,21 +4061,21 @@
 #endif
 
 void
-Perl_warner()
+Perl_warner(aTHX)
         CODE:
 #if (PERL_BCDVERSION >= 0x5004000)
                 Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42);
 #endif
 
 void
-Perl_ck_warner()
+Perl_ck_warner(aTHX)
         CODE:
 #if (PERL_BCDVERSION >= 0x5004000)
                 Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Perl_ck_warner %s:%d", "bar", 42);
 #endif
 
 void
-Perl_ck_warner_d()
+Perl_ck_warner_d(aTHX)
         CODE:
 #if (PERL_BCDVERSION >= 0x5004000)
                 Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC), "Perl_ck_warner_d %s:%d", "bar", 42);

[toddr]

Suggested changes:
--- PathTools/Cwd.xs
+++ PathTools/Cwd.xs.patched
@@ -289,8 +289,8 @@
 
 #ifndef getcwd_sv
 /* Taken from perl 5.8's util.c */
-#define getcwd_sv(a) Perl_getcwd_sv(aTHX_ a)
-int Perl_getcwd_sv(pTHX_ SV *sv)
+#define getcwd_sv(a) getcwd_sv(a)
+int getcwd_sv(pTHX_ SV *sv)
 {
 #ifndef PERL_MICRO
 

[toddr]

Suggested changes:
--- threads/threads.xs
+++ threads/threads.xs.patched
@@ -850,7 +850,7 @@
      */
     {
 #if PERL_VERSION_GE(5,13,2)
-        CLONE_PARAMS *clone_param = Perl_clone_params_new(aTHX, thread->interp);
+        CLONE_PARAMS *clone_param = clone_params_new(, thread->interp);
 #else
         CLONE_PARAMS clone_param_s;
         CLONE_PARAMS *clone_param = &clone_param_s;
@@ -898,7 +898,7 @@
         }
 
 #if PERL_VERSION_GE(5,13,2)
-        Perl_clone_params_del(clone_param);
+        clone_params_del(clone_param);
 #endif
 
 #if PERL_VERSION_LT(5,8,8)
@@ -1363,7 +1363,7 @@
 #else
             AV *params_copy;
             PerlInterpreter *other_perl = thread->interp;
-            CLONE_PARAMS *clone_params = Perl_clone_params_new(other_perl, aTHX);
+            CLONE_PARAMS *clone_params = clone_params_new(other_perl, aTHX);
 
             params_copy = thread->params;
             clone_params->flags |= CLONEf_JOIN_IN;
@@ -1378,7 +1378,7 @@
 #  endif
             params = (AV *)sv_dup((SV*)params_copy, clone_params);
             S_ithread_set(aTHX_ current_thread);
-            Perl_clone_params_del(clone_params);
+            clone_params_del(clone_params);
             SvREFCNT_inc_void(params);
             ptr_table_free(PL_ptr_table);
             PL_ptr_table = NULL;
@@ -1793,7 +1793,7 @@
             PL_ptr_table = NULL;
 #else
             PerlInterpreter *other_perl = thread->interp;
-            CLONE_PARAMS *clone_params = Perl_clone_params_new(other_perl, aTHX);
+            CLONE_PARAMS *clone_params = clone_params_new(other_perl, aTHX);
             ithread *current_thread;
 
             clone_params->flags |= CLONEf_JOIN_IN;
@@ -1809,7 +1809,7 @@
 #  endif
             err = sv_dup(thread->err, clone_params);
             S_ithread_set(aTHX_ current_thread);
-            Perl_clone_params_del(clone_params);
+            clone_params_del(clone_params);
             SvREFCNT_inc_void(err);
             /* If error was an object, bless it into the correct class */
             if (thread->err_class) {

[Leont]

However, it made some bad suggestions which @khwilliamson indicated might be bugs in need of investigation.

IME, the recommentation is much better if I set --compat-version to something like 5.008. By default it tries to be compatible with 5.003, and that's just silly and unnecessary. That way it won't require things like NEED_mess_nocontext and NEED_vmess

[Leont]

Personally, I really don't really like how aggressively it's telling people to use G_LIST instead of G_ARRAY. The old way isn't quite wrong IMO.

[Leont]

It's kind of messing up clone_params_new and clone_params_del because those don't actually exist without ppport (only the Perl_ prefixed versions do), so that's a ppport bug there. That said, that situation does seem a bit silly.

[toddr]

The suggestions made for dist/Data-Dumper appear to also have been bad. Noting that here.

[demerphq]

I don't think the suggestion to use my_snprintf() instead of my_sprintf() are /bad/, my_snprintf() is by far the safer of the two, the issue is that my_snprintf() is not a drop in replacement. The 'n' refers to length protections, and use of such functions requires an additional argument and additional return processing. Ideally code would only use the 'n' api variants as they are safer, the older api's are prone to mistakes, and maybe even buffer overruns.