Squash COWs in the char* typemap

Some XS modules expect to be able to modify strings passed in as char
pointers.  Copy-on-write breaks that ability.  So this commit makes
the T_PV typemap uncow mutable COWs when passing them.

const char* is now mapped to the new T_ROPV entry, to avoiding unnec-
essarily slowing it down.

Steffen Müller writes in <52912E9C.3030403@cpan.org> that the typemap
is not dual-lifed, so it is not necessary to make this 5.16-compati-
ble.  However, I had already written the patch, and I think it is good
to keep it possible to drop this typemap into a CPAN distribution.
Any self-respecting C compiler should be able to optimise away the
extra SvIsCOW(t_pv_tmp_sv) == 1 check, so there is no slowdown as a
result of compatibility.

diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm
index 583726a528aef1af9e95dc6da3caa67474c8e0c7..d78134f7cffe4ccf20571c8e43cd8793e36a72f1 100644 (file)
--- a/ext/XS-Typemap/Typemap.pm
+++ b/ext/XS-Typemap/Typemap.pm
@@ -66,7 +66,7 @@ $VERSION = '0.12';
            T_FLOAT
            T_NV
           T_DOUBLE
-          T_PV T_PV_null
+          T_PV T_PV_null T_PV_mutate T_ROPV
           T_PTR_IN T_PTR_OUT
           T_PTRREF_IN T_PTRREF_OUT
           T_REF_IV_REF

diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs
index 0eb68e54eec4363a8f8ca07f7759ff5da4eb6f74..8892ea697b653a6f69b078cb26727da4530de76e 100644 (file)
--- a/ext/XS-Typemap/Typemap.xs
+++ b/ext/XS-Typemap/Typemap.xs
@@ -579,6 +579,28 @@ T_PV_null()
  OUTPUT:
   RETVAL
 
+void
+T_PV_mutate( in, repl, len )
+  char * in
+  char * repl
+  STRLEN len
+ PREINIT:
+  STRLEN i = 0;
+ CODE:
+  for (; i < len; i++)
+   in[i] = repl[i];
+
+
+## T_ROPV
+
+const char *
+T_ROPV( in )
+  const char * in
+ CODE:
+  RETVAL = in;
+ OUTPUT:
+  RETVAL
+
 
 ## T_PTR
 

diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t
index e251c55e7f2c57a9ac43b5a1ce220e4d76956b2a..0a3994d10d85c551c7f4abd8bbc1389d5934decc 100644 (file)
--- a/ext/XS-Typemap/t/Typemap.t
+++ b/ext/XS-Typemap/t/Typemap.t
@@ -6,7 +6,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 148;
+use Test::More tests => 152;
 
 use strict;
 use warnings;
@@ -218,6 +218,17 @@ ok !defined T_PV_null, 'RETVAL = NULL returns undef for char*';
     () = ''.T_PV_null;
     is $uninit, 1, 'uninit warning from NULL returned from char* func';
 }
+for my $cow (keys %{{foo=>1}}) {
+    my $cow2 = $cow;
+    T_PV_mutate($cow, "bar", 2);
+    is( $cow, "bao", "mutating cows via char* param" );
+    is( $cow2, "foo", "kin kine are unaffected" );
+}
+
+# T_ROPV
+note("T_ROPV");
+is( T_ROPV("a string"), "a string");
+is( T_ROPV(52), 52);
 
 # T_PTR
 my $t = 5;

diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap
index 874bc161a8071432f9716f371e59e48db0eae96c..03804190776720cafc7e766defabe1a315aae5e4 100644 (file)
--- a/lib/ExtUtils/typemap
+++ b/lib/ExtUtils/typemap
@@ -10,7 +10,7 @@ char                  T_CHAR
 unsigned char          T_U_CHAR
 char *                 T_PV
 unsigned char *                T_PV
-const char *           T_PV
+const char *           T_ROPV
 caddr_t                        T_PV
 wchar_t *              T_PV
 wchar_t                        T_IV
@@ -200,6 +200,24 @@ T_NV
 T_DOUBLE
        $var = (double)SvNV($arg)
 T_PV
+       STMT_START {
+               SV * const t_pv_tmp_sv = $arg;
+               /* Note: This code works in 5.16 as well as 5.20, which is
+                  not strictly necessary, since this typemap is not dual-
+                  lifed.  However, keeping this extra logic will make it
+                  easier to backport if we decide to dual-life it, or if
+                  someone copies the latest typemap into a CPAN dist.  */
+               /* This takes advantage of the fact that SvIsCOW always
+                  returned 1 or 0 back when all COWs were marked read-only
+                  (pre-v5.17.5-484-ge3918bb0, when SvREADONLY did not nec-
+                  essarily actually mean read-only) and SVf_IsCOW or 0
+                  thereafter. */
+               if ((SvIsCOW(t_pv_tmp_sv) && !SvREADONLY(t_pv_tmp_sv))
+                || SvIsCOW(t_pv_tmp_sv) == 1)
+                   sv_force_normal(t_pv_tmp_sv);
+               $var = ($type)SvPV_nolen(t_pv_tmp_sv);
+       } STMT_END
+T_ROPV
        $var = ($type)SvPV_nolen($arg)
 T_PTR
        $var = INT2PTR($type,SvIV($arg))
@@ -351,6 +369,8 @@ T_DOUBLE
        sv_setnv($arg, (double)$var);
 T_PV
        sv_setpv((SV*)$arg, $var);
+T_ROPV
+       sv_setpv((SV*)$arg, $var);
 T_PTR
        sv_setiv($arg, PTR2IV($var));
 T_PTRREF