Also add repaired variants for CV and SVREF typemaps

diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm
index e43970f..20e51b5 100644 (file)
--- a/ext/XS-Typemap/Typemap.pm
+++ b/ext/XS-Typemap/Typemap.pm
@@ -36,16 +36,18 @@ require XSLoader;
 
 use vars qw/ $VERSION @EXPORT /;
 
-$VERSION = '0.06';
+$VERSION = '0.07';
 
 @EXPORT = (qw/
           T_SV
           T_SVREF
+          T_SVREF_REFCOUNT_FIXED
           T_AVREF
           T_AVREF_REFCOUNT_FIXED
           T_HVREF
           T_HVREF_REFCOUNT_FIXED
           T_CVREF
+          T_CVREF_REFCOUNT_FIXED
           T_SYSRET_fail T_SYSRET_pass
           T_UV
           T_IV

diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs
index 3b24ca7..9684f50 100644 (file)
--- a/ext/XS-Typemap/Typemap.xs
+++ b/ext/XS-Typemap/Typemap.xs
@@ -45,9 +45,11 @@ static intRefIv xst_anintrefiv;
 static intOpq xst_anintopq;
 
 /* A different type to refer to for testing the different
- * AV* and HV* typemaps */
+ * AV*, HV*, etc typemaps */
 typedef AV AV_FIXED;
 typedef HV HV_FIXED;
+typedef CV CV_FIXED;
+typedef SVREF SVREF_FIXED;
 
 /* Helper functions */
 
@@ -98,6 +100,10 @@ T_SV( sv )
 
 Used to pass in and return a reference to an SV.
 
+Note that this typemap does not decrement the reference count
+when returning the reference to an SV*.
+See also: T_SVREF_REFCOUNT_FIXED
+
 =cut
 
 SVREF
@@ -108,6 +114,24 @@ T_SVREF( svref )
  OUTPUT:
   RETVAL
 
+=item T_SVREF_FIXED
+
+Used to pass in and return a reference to an SV.
+This is a fixed
+variant of T_SVREF that decrements the refcount appropriately
+when returning a reference to an SV*. Introduced in perl 5.15.4.
+
+=cut
+
+SVREF_FIXED
+T_SVREF_REFCOUNT_FIXED( svref )
+  SVREF_FIXED svref
+ CODE:
+  SvREFCNT_inc(svref);
+  RETVAL = svref;
+ OUTPUT:
+  RETVAL
+
 =item T_AVREF
 
 From the perl level this is a reference to a perl array.
@@ -187,6 +211,9 @@ From the perl level this is a reference to a perl subroutine
 (e.g. $sub = sub { 1 };). From the C level this is a pointer
 to a CV.
 
+Note that this typemap does not decrement the reference count
+when returning an HV*. See also: T_HVREF_REFCOUNT_FIXED
+
 =cut
 
 CV *
@@ -197,6 +224,26 @@ T_CVREF( cv )
  OUTPUT:
   RETVAL
 
+=item T_CVREF_REFCOUNT_FIXED
+
+From the perl level this is a reference to a perl subroutine
+(e.g. $sub = sub { 1 };). From the C level this is a pointer
+to a CV.
+
+This is a fixed
+variant of T_HVREF that decrements the refcount appropriately
+when returning an HV*. Introduced in perl 5.15.4.
+
+=cut
+
+CV_FIXED *
+T_CVREF_REFCOUNT_FIXED( cv )
+  CV_FIXED * cv
+ CODE:
+  SvREFCNT_inc(cv);
+  RETVAL = cv;
+ OUTPUT:
+  RETVAL
 
 =item T_SYSRET
 

diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t
index 60f42ba..c8ab9f9 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 => 88;
+use Test::More tests => 92;
 
 use strict;
 use warnings;
@@ -45,6 +45,10 @@ is( T_SVREF($svref), $svref );
 eval { T_SVREF( "fail - not ref" ) };
 ok( $@ );
 
+is( T_SVREF_REFCOUNT_FIXED($svref), $svref );
+eval { T_SVREF_REFCOUNT_FIXED( "fail - not ref" ) };
+ok( $@ );
+
 
 # T_AVREF - reference to a perl Array
 print "# T_AVREF\n";
@@ -97,6 +101,13 @@ is( T_CVREF($sub), $sub );
 eval { T_CVREF( \@array ) };
 ok( $@ );
 
+is( T_CVREF_REFCOUNT_FIXED($sub), $sub );
+
+# Now test that a non code ref is rejected
+eval { T_CVREF_REFCOUNT_FIXED( \@array ) };
+ok( $@ );
+
+
 # T_SYSRET - system return values
 print "# T_SYSRET\n";
 

diff --git a/ext/XS-Typemap/typemap b/ext/XS-Typemap/typemap
index 13e655a..52c130f 100644 (file)
--- a/ext/XS-Typemap/typemap
+++ b/ext/XS-Typemap/typemap
@@ -19,3 +19,5 @@ shortOPQ *      T_OPAQUEPTR
 astruct *       T_OPAQUEPTR
 AV_FIXED *     T_AVREF_REFCOUNT_FIXED
 HV_FIXED *     T_HVREF_REFCOUNT_FIXED
+CV_FIXED *     T_CVREF_REFCOUNT_FIXED
+SVREF_FIXED    T_SVREF_REFCOUNT_FIXED

diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap
index 1e84212..2ce74b1 100644 (file)
--- a/lib/ExtUtils/typemap
+++ b/lib/ExtUtils/typemap
@@ -24,13 +24,14 @@ char **                     T_PACKEDARRAY
 void *                 T_PTR
 Time_t *               T_PV
 SV *                   T_SV
-SVREF                  T_SVREF
-CV *                   T_CVREF
 
 # These are the backwards-compatibility AV*/HV* typemaps that
 # do not decrement refcounts. Locally override with
-# "AV* T_AVREF_REFCOUNT_FIXED" and/or
-# "HV* T_HVREF_REFCOUNT_FIXED" to get the fixed version.
+# "AV* T_AVREF_REFCOUNT_FIXED", "HV*   T_HVREF_REFCOUNT_FIXED",
+# "CV* T_CVREF_REFCOUNT_FIXED", "SVREF T_SVREF_REFCOUNT_FIXED",
+# to get the fixed versions.
+SVREF                  T_SVREF
+CV *                   T_CVREF
 AV *                   T_AVREF
 HV *                   T_HVREF
 
@@ -75,6 +76,19 @@ T_SVREF
                                \"$var\");
                }
        } STMT_END
+T_SVREF_REFCOUNT_FIXED
+       STMT_START {
+               SV* const xsub_tmp_sv = $arg;
+               SvGETMAGIC(xsub_tmp_sv);
+               if (SvROK(xsub_tmp_sv)){
+                   $var = SvRV(xsub_tmp_sv);
+               }
+               else{
+                   Perl_croak(aTHX_ \"%s: %s is not a reference\",
+                               ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+                               \"$var\");
+               }
+       } STMT_END
 T_AVREF
        STMT_START {
                SV* const xsub_tmp_sv = $arg;
@@ -140,6 +154,19 @@ T_CVREF
                                \"$var\");
                }
        } STMT_END
+T_CVREF_REFCOUNT_FIXED
+       STMT_START {
+               SV* const xsub_tmp_sv = $arg;
+               SvGETMAGIC(xsub_tmp_sv);
+               if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVCV){
+                   $var = (CV*)SvRV(xsub_tmp_sv);
+               }
+               else{
+                   Perl_croak(aTHX_ \"%s: %s is not a CODE reference\",
+                               ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+                               \"$var\");
+               }
+       } STMT_END
 T_SYSRET
        $var NOT IMPLEMENTED
 T_UV
@@ -273,6 +300,8 @@ T_SV
        $arg = $var;
 T_SVREF
        $arg = newRV((SV*)$var);
+T_SVREF_REFCOUNT_FIXED
+       $arg = newRV_noinc((SV*)$var);
 T_AVREF
        $arg = newRV((SV*)$var);
 T_AVREF_REFCOUNT_FIXED
@@ -283,6 +312,8 @@ T_HVREF_REFCOUNT_FIXED
        $arg = newRV_noinc((SV*)$var);
 T_CVREF
        $arg = newRV((SV*)$var);
+T_CVREF_REFCOUNT_FIXED
+       $arg = newRV_noinc((SV*)$var);
 T_IV
        sv_setiv($arg, (IV)$var);
 T_UV