A repaired, properly refcounting AV&HV typemap

The T_AVREF_REFCOUNT_FIXED and T_HVREF_REFCOUNT_FIXED can be used
in place of T_AVREF/T_HVREF. They do away with having to remember
to decrement refcounts manually.

diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm
index c3d2a79..e43970f 100644 (file)
--- a/ext/XS-Typemap/Typemap.pm
+++ b/ext/XS-Typemap/Typemap.pm
@@ -36,13 +36,15 @@ require XSLoader;
 
 use vars qw/ $VERSION @EXPORT /;
 
-$VERSION = '0.05';
+$VERSION = '0.06';
 
 @EXPORT = (qw/
           T_SV
           T_SVREF
           T_AVREF
+          T_AVREF_REFCOUNT_FIXED
           T_HVREF
+          T_HVREF_REFCOUNT_FIXED
           T_CVREF
           T_SYSRET_fail T_SYSRET_pass
           T_UV

diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs
index 2f8b3bc..3b24ca7 100644 (file)
--- a/ext/XS-Typemap/Typemap.xs
+++ b/ext/XS-Typemap/Typemap.xs
@@ -44,6 +44,11 @@ static intObj xst_anintobj;
 static intRefIv xst_anintrefiv;
 static intOpq xst_anintopq;
 
+/* A different type to refer to for testing the different
+ * AV* and HV* typemaps */
+typedef AV AV_FIXED;
+typedef HV HV_FIXED;
+
 /* Helper functions */
 
 /* T_ARRAY - allocate some memory */
@@ -108,6 +113,9 @@ T_SVREF( svref )
 From the perl level this is a reference to a perl array.
 From the C level this is a pointer to an AV.
 
+Note that this typemap does not decrement the reference count
+when returning an AV*. See also: T_AVREF_REFCOUNT_FIXED
+
 =cut
 
 AV *
@@ -118,11 +126,32 @@ T_AVREF( av )
  OUTPUT:
   RETVAL
 
+=item T_AVREF_REFCOUNT_FIXED
+
+From the perl level this is a reference to a perl array.
+From the C level this is a pointer to an AV. This is a fixed
+variant of T_AVREF that decrements the refcount appropriately
+when returning an AV*. Introduced in perl 5.15.4.
+
+=cut
+
+AV_FIXED*
+T_AVREF_REFCOUNT_FIXED( av )
+  AV_FIXED * av
+ CODE:
+  SvREFCNT_inc(av);
+  RETVAL = av;
+ OUTPUT:
+  RETVAL
+
 =item T_HVREF
 
 From the perl level this is a reference to a perl hash.
 From the C level this is a pointer to an HV.
 
+Note that this typemap does not decrement the reference count
+when returning an HV*. See also: T_HVREF_REFCOUNT_FIXED
+
 =cut
 
 HV *
@@ -133,6 +162,25 @@ T_HVREF( hv )
  OUTPUT:
   RETVAL
 
+=item T_HVREF_REFCOUNT_FIXED
+
+From the perl level this is a reference to a perl hash.
+From the C level this is a pointer to an HV. This is a fixed
+variant of T_HVREF that decrements the refcount appropriately
+when returning an HV*. Introduced in perl 5.15.4.
+
+=cut
+
+HV_FIXED*
+T_HVREF_REFCOUNT_FIXED( hv )
+  HV_FIXED * hv
+ CODE:
+  SvREFCNT_inc(hv);
+  RETVAL = hv;
+ OUTPUT:
+  RETVAL
+
+
 =item T_CVREF
 
 From the perl level this is a reference to a perl subroutine

diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t
index c2c1c49..60f42ba 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 => 84;
+use Test::More tests => 88;
 
 use strict;
 use warnings;
@@ -45,6 +45,7 @@ is( T_SVREF($svref), $svref );
 eval { T_SVREF( "fail - not ref" ) };
 ok( $@ );
 
+
 # T_AVREF - reference to a perl Array
 print "# T_AVREF\n";
 
@@ -55,6 +56,16 @@ is( T_AVREF(\@array), \@array);
 eval { T_AVREF( \$sv ) };
 ok( $@ );
 
+# T_AVREF_REFCOUNT_FIXED  - reference to a perl Array, refcount fixed
+print "# T_AVREF_REFCOUNT_FIXED\n";
+
+is( T_AVREF_REFCOUNT_FIXED(\@array), \@array);
+
+# Now test that a non array ref is rejected
+eval { T_AVREF_REFCOUNT_FIXED( \$sv ) };
+ok( $@ );
+
+
 # T_HVREF - reference to a perl Hash
 print "# T_HVREF\n";
 
@@ -66,6 +77,17 @@ eval { T_HVREF( \@array ) };
 ok( $@ );
 
 
+# T_HVREF_REFCOUNT_FIXED - reference to a perl Hash, refcount fixed
+print "# T_HVREF_REFCOUNT_FIXED\n";
+
+is( T_HVREF_REFCOUNT_FIXED(\%hash), \%hash);
+
+# Now test that a non hash ref is rejected
+eval { T_HVREF_REFCOUNT_FIXED( \@array ) };
+ok( $@ );
+
+
+
 # T_CVREF - reference to perl subroutine
 print "# T_CVREF\n";
 my $sub = sub { 1 };

diff --git a/ext/XS-Typemap/typemap b/ext/XS-Typemap/typemap
index 2b0d2bf..13e655a 100644 (file)
--- a/ext/XS-Typemap/typemap
+++ b/ext/XS-Typemap/typemap
@@ -17,3 +17,5 @@ intOpq   *      T_OPAQUEPTR
 shortOPQ          T_OPAQUE
 shortOPQ *      T_OPAQUEPTR
 astruct *       T_OPAQUEPTR
+AV_FIXED *     T_AVREF_REFCOUNT_FIXED
+HV_FIXED *     T_HVREF_REFCOUNT_FIXED

diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap
index c88238a..1e84212 100644 (file)
--- a/lib/ExtUtils/typemap
+++ b/lib/ExtUtils/typemap
@@ -25,9 +25,14 @@ 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
 HV *                   T_HVREF
-CV *                   T_CVREF
 
 IV                     T_IV
 UV                     T_UV
@@ -83,6 +88,19 @@ T_AVREF
                                \"$var\");
                }
        } STMT_END
+T_AVREF_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_PVAV){
+                   $var = (AV*)SvRV(xsub_tmp_sv);
+               }
+               else{
+                   Perl_croak(aTHX_ \"%s: %s is not an ARRAY reference\",
+                               ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+                               \"$var\");
+               }
+       } STMT_END
 T_HVREF
        STMT_START {
                SV* const xsub_tmp_sv = $arg;
@@ -96,6 +114,19 @@ T_HVREF
                                \"$var\");
                }
        } STMT_END
+T_HVREF_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_PVHV){
+                   $var = (HV*)SvRV(xsub_tmp_sv);
+               }
+               else{
+                   Perl_croak(aTHX_ \"%s: %s is not a HASH reference\",
+                               ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+                               \"$var\");
+               }
+       } STMT_END
 T_CVREF
        STMT_START {
                SV* const xsub_tmp_sv = $arg;
@@ -244,8 +275,12 @@ T_SVREF
        $arg = newRV((SV*)$var);
 T_AVREF
        $arg = newRV((SV*)$var);
+T_AVREF_REFCOUNT_FIXED
+       $arg = newRV_noinc((SV*)$var);
 T_HVREF
        $arg = newRV((SV*)$var);
+T_HVREF_REFCOUNT_FIXED
+       $arg = newRV_noinc((SV*)$var);
 T_CVREF
        $arg = newRV((SV*)$var);
 T_IV