test and fix using T_CVREF_REFCOUNT as an output parameter

Perl · Sep 9, 2021 · 50034e0 · 50034e0
1 parent 08d4598
commit 50034e0
Show file tree

Hide file tree

Showing 4 changed files with 17 additions and 2 deletions.
diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm
@@ -50,6 +50,7 @@ our @EXPORT = (qw/
 	   T_HVREF_REFCOUNT_FIXED_output
 	   T_CVREF
 	   T_CVREF_REFCOUNT_FIXED
+	   T_CVREF_REFCOUNT_FIXED_output
 	   T_SYSRET_fail T_SYSRET_pass
 	   T_UV
 	   T_IV

diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs
@@ -383,6 +383,12 @@ T_CVREF_REFCOUNT_FIXED( cv )
  OUTPUT:
   RETVAL
 
+void
+T_CVREF_REFCOUNT_FIXED_output( OUT cvref)
+  CV_FIXED *cvref;
+ CODE:
+  cvref = get_cv("XSLoader::load", 0);
+  SvREFCNT_inc(cvref);
 
 ## T_SYSRET
 

diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t
@@ -6,7 +6,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 167;
+use Test::More tests => 170;
 
 use strict;
 #catch WARN_INTERNAL type errors, and anything else unexpected
@@ -126,6 +126,14 @@ is( T_CVREF_REFCOUNT_FIXED($sub), $sub );
 eval { T_CVREF_REFCOUNT_FIXED( \@array ) };
 ok( $@ );
 
+# output only
+SKIP:{
+   my $cvr;
+   is_deeply([ T_CVREF_REFCOUNT_FIXED_output($cvr) ], [ ], "call with non-ref lvalue, no return value");
+   ok(ref $cvr, "output parameter now a reference")
+     or skip "Not a reference", 1;
+   is($cvr, \&XSLoader::load, "ref to expected sub");
+}
 
 # T_SYSRET - system return values
 note("T_SYSRET");

diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap
@@ -331,7 +331,7 @@ T_HVREF_REFCOUNT_FIXED
 T_CVREF
 	$arg = newRV((SV*)$var);
 T_CVREF_REFCOUNT_FIXED
-	$arg = newRV_noinc((SV*)$var);
+	${ "$var" eq "RETVAL" ? \"$arg = newRV_noinc((SV*)$var);" : \"sv_setrv_noinc($arg, (SV*)$var);" }
 T_IV
 	sv_setiv($arg, (IV)$var);
 T_UV