Add Perl support for std::unique_ptr inputs

Equivalent to Java/C#/Python/Ruby implementations.

Examples/test-suite/perl5/cpp11_std_unique_ptr_runme.pl

@@ -1,9 +1,67 @@
 use strict;
 use warnings;
-use Test::More tests => 6;
+use Test::More tests => 24;
 BEGIN { use_ok('cpp11_std_unique_ptr') }
 require_ok('cpp11_std_unique_ptr');
 
+# adapted from ../java/cpp11_std_unique_ptr_runme.java
+
+sub checkCount {
+  my($expected_count) = @_;
+  my $actual_count = cpp11_std_unique_ptr::Klass::getTotal_count();
+  is($actual_count, $expected_count, "Counts incorrect, expected: $expected_count actual: $actual_count");
+}
+
+# unique_ptr as input
+{
+  my $kin = new cpp11_std_unique_ptr::Klass("KlassInput");
+  checkCount(1);
+  my $s = cpp11_std_unique_ptr::takeKlassUniquePtr($kin);
+  checkCount(0);
+  is($s, "KlassInput", "Incorrect string: $s");
+  is(cpp11_std_unique_ptr::is_nullptr($kin), 1, "is_nullptr check");
+  undef $kin; # Should not fail, even though already deleted
+  checkCount(0);
+}
+
+{
+  my $kin = new cpp11_std_unique_ptr::Klass("KlassInput");
+  checkCount(1);
+  my $s = cpp11_std_unique_ptr::takeKlassUniquePtr($kin);
+  checkCount(0);
+  is($s, "KlassInput", "Incorrect string: $s");
+  is(cpp11_std_unique_ptr::is_nullptr($kin), 1, "is_nullptr check");
+  eval {
+    cpp11_std_unique_ptr::takeKlassUniquePtr($kin);
+  };
+  like($@, qr/\bcannot release ownership as memory is not owned\b/, "double usage of takeKlassUniquePtr should be an error");
+  undef $kin; # Should not fail, even though already deleted
+  checkCount(0);
+}
+
+{
+  my $kin = new cpp11_std_unique_ptr::Klass("KlassInput");
+  eval {
+    my $notowned = cpp11_std_unique_ptr::get_not_owned_ptr($kin);
+    cpp11_std_unique_ptr::takeKlassUniquePtr($notowned);
+  };
+  like($@, qr/\bcannot release ownership as memory is not owned\b/, "double usage of takeKlassUniquePtr should be an error");
+  undef $kin;
+  checkCount(0);
+}
+
+{
+  my $kini = new cpp11_std_unique_ptr::KlassInheritance("KlassInheritanceInput");
+  checkCount(1);
+  my $s = cpp11_std_unique_ptr::takeKlassUniquePtr($kini);
+  checkCount(0);
+  is($s, "KlassInheritanceInput", "Incorrect string: $s");
+  is(cpp11_std_unique_ptr::is_nullptr($kini), 1, "is_nullptr failed");
+  undef $kini; # Should not fail, even though already deleted
+  checkCount(0);
+}
+
+# unique_ptr as output
 my $k1 = cpp11_std_unique_ptr::makeKlassUniquePtr("first");
 my $k2 = cpp11_std_unique_ptr::makeKlassUniquePtr("second");
 is(cpp11_std_unique_ptr::Klass::getTotal_count, 2, "have 2 pointers");

Lib/perl5/perlrun.swg

@@ -210,6 +210,7 @@ SWIG_Perl_ConvertPtrAndOwn(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_
   swig_cast_info *tc;
   void *voidptr = (void *)0;
   SV *tsv = 0;
+  int check_owned_pointer_release = (flags & SWIG_POINTER_RELEASE) == SWIG_POINTER_RELEASE;
 
   if (own)
     *own = 0;
@@ -286,13 +287,14 @@ SWIG_Perl_ConvertPtrAndOwn(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_
   /* 
    *  DISOWN implementation: we need a perl guru to check this one.
    */
-  if (tsv && (flags & SWIG_POINTER_DISOWN)) {
+  if (tsv && ((flags & SWIG_POINTER_DISOWN) || check_owned_pointer_release)) {
     /* 
      *  almost copy paste code from below SWIG_POINTER_OWN setting
      */
     SV *obj = sv;
     HV *stash = SvSTASH(SvRV(obj));
     GV *gv = *(GV**)hv_fetch(stash, "OWNER", 5, TRUE);
+    int owned = 0;
     if (isGV(gv)) {
       HV *hv = GvHVn(gv);
       /*
@@ -300,10 +302,21 @@ SWIG_Perl_ConvertPtrAndOwn(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_
        * Hence, to remove ownership, we delete the entry.
        */
       if (hv_exists_ent(hv, obj, 0)) {
-	hv_delete_ent(hv, obj, 0, 0);
+        owned = 1;
+        if (flags & SWIG_POINTER_DISOWN) {
+          hv_delete_ent(hv, obj, 0, 0);
+        }
       }
     }
+    if (check_owned_pointer_release && !owned) {
+      return SWIG_ERROR_RELEASE_NOT_OWNED;
+    }
   }
+
+  if (tsv && (flags & SWIG_POINTER_CLEAR)) {
+    SvIV_set(tsv, 0);
+  }
+
   return SWIG_OK;
 }
 

Lib/perl5/std_unique_ptr.i

@@ -8,9 +8,22 @@
  * ----------------------------------------------------------------------------- */
 
 %define %unique_ptr(TYPE)
+%typemap(in, noblock=1) std::unique_ptr< TYPE > (void *argp = 0, int res = 0) {
+  res = SWIG_ConvertPtr($input, &argp, $descriptor(TYPE *), SWIG_POINTER_RELEASE | %convertptr_flags);
+  if (!SWIG_IsOK(res)) {
+    if (res == SWIG_ERROR_RELEASE_NOT_OWNED) {
+      %releasenotowned_fail(res, "TYPE *", $symname, $argnum);
+    } else {
+      %argument_fail(res, "TYPE *", $symname, $argnum);
+    }
+  }
+  $1.reset((TYPE *)argp);
+}
+
 %typemap (out) std::unique_ptr< TYPE > %{
    %set_output(SWIG_NewPointerObj($1.release(), $descriptor(TYPE *), SWIG_POINTER_OWN | %newpointer_flags));
 %}
+
 %template() std::unique_ptr< TYPE >;
 %enddef