Add Guile support for std::unique_ptr and std::auto_ptr

Equivalent to Python/Ruby implementations.

CHANGES.current

@@ -7,6 +7,10 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/
 Version 4.1.0 (in progress)
 ===========================
 
+2022-08-13: wsfulton
+            [Guile] Add support for std::unique_ptr in std_unique_ptr.i.
+            Add support for std::auto_ptr in std_auto_ptr.i.
+
 2022-08-11: wsfulton
             [Lua] Add support for std::unique_ptr in std_unique_ptr.i.
             Add support for std::auto_ptr in std_auto_ptr.i.

Examples/test-suite/cpp11_std_unique_ptr.i

@@ -1,6 +1,6 @@
 %module cpp11_std_unique_ptr
 
-#if !(defined(SWIGGO) || defined(SWIGGUILE) || defined(SWIGOCAML) || defined(SWIGMZSCHEME) || defined(SWIGR) || defined(SWIGSCILAB))
+#if !(defined(SWIGGO) || defined(SWIGOCAML) || defined(SWIGMZSCHEME) || defined(SWIGR) || defined(SWIGSCILAB))
 
 %include "std_string.i"
 %include "std_unique_ptr.i"

Examples/test-suite/guile/cpp11_std_unique_ptr_runme.scm

@@ -0,0 +1,3 @@
+(dynamic-call "scm_init_cpp11_std_unique_ptr_module" (dynamic-link "./libcpp11_std_unique_ptr"))
+(load "testsuite.scm")
+(load "../schemerunme/cpp11_std_unique_ptr.scm")

Examples/test-suite/guile/li_std_auto_ptr_runme.scm

@@ -0,0 +1,3 @@
+(dynamic-call "scm_init_li_std_auto_ptr_module" (dynamic-link "./libli_std_auto_ptr"))
+(load "testsuite.scm")
+(load "../schemerunme/li_std_auto_ptr.scm")

Examples/test-suite/li_std_auto_ptr.i

@@ -12,7 +12,7 @@
 #endif
 %}
 
-#if !(defined(SWIGGO) || defined(SWIGGUILE) || defined(SWIGOCAML) || defined(SWIGMZSCHEME) || defined(SWIGR) || defined(SWIGSCILAB))
+#if !(defined(SWIGGO) || defined(SWIGOCAML) || defined(SWIGMZSCHEME) || defined(SWIGR) || defined(SWIGSCILAB))
 
 %include "std_string.i"
 //#include <iostream>

Examples/test-suite/schemerunme/cpp11_std_unique_ptr.scm

@@ -0,0 +1,75 @@
+(define checkCount
+  (lambda (expected-count)
+    (define actual-count (Klass-getTotal-count))
+    (if (not (= actual-count expected-count)) (error "Counts incorrect, expected:" expected-count " actual:" actual-count))))
+
+; Test raw pointer handling involving virtual inheritance
+(define kini (new-KlassInheritance "KlassInheritanceInput"))
+(checkCount 1)
+(define s (useKlassRawPtr kini))
+(if (not (string=? s "KlassInheritanceInput"))
+  (error "Incorrect string: " s))
+(delete-Klass kini)
+(checkCount 0)
+
+; unique_ptr as input
+(define kin (new-Klass "KlassInput"))
+(checkCount 1)
+(define s (takeKlassUniquePtr kin))
+(checkCount 0)
+(if (not (string=? s "KlassInput"))
+  (error "Incorrect string: " s))
+(if (not (is-nullptr kin))
+  (error "is_nullptr failed"))
+(delete-Klass kin) ; Should not fail, even though already deleted
+(checkCount 0)
+
+(define kin (new-Klass "KlassInput"))
+(checkCount 1)
+(define s (takeKlassUniquePtr kin))
+(checkCount 0)
+(if (not (string=? s "KlassInput"))
+  (error "Incorrect string: " s))
+(if (not (is-nullptr kin))
+  (error "is_nullptr failed"))
+(expect-throw 'misc-error 
+              (takeKlassUniquePtr kin))
+; TODO: check the exception message
+(delete-Klass kin) ; Should not fail, even though already deleted
+(checkCount 0)
+
+(define kin (new-Klass "KlassInput"))
+(define notowned (get-not-owned-ptr kin))
+(expect-throw 'misc-error 
+              (takeKlassUniquePtr notowned))
+; TODO: check the exception message
+(checkCount 1)
+(delete-Klass kin)
+(checkCount 0)
+
+(define kini (new-KlassInheritance "KlassInheritanceInput"))
+(checkCount 1)
+(define s (takeKlassUniquePtr kini))
+(checkCount 0)
+(if (not (string=? s "KlassInheritanceInput"))
+  (error "Incorrect string: " s))
+(if (not (is-nullptr kini))
+  (error "is_nullptr failed"))
+(delete-Klass kini) ; Should not fail, even though already deleted
+(checkCount 0)
+
+; unique_ptr as output
+(define k1 (makeKlassUniquePtr "first"))
+(define k2 (makeKlassUniquePtr "second"))
+(checkCount 2)
+
+(delete-Klass k1)
+(checkCount 1)
+
+(if (not (string=? (Klass-getLabel k2) "second"))
+  (error "wrong object label" ))
+
+(delete-Klass k2)
+(checkCount 0)
+
+(exit 0)

Examples/test-suite/schemerunme/li_std_auto_ptr.scm

@@ -0,0 +1,75 @@
+(define checkCount
+  (lambda (expected-count)
+    (define actual-count (Klass-getTotal-count))
+    (if (not (= actual-count expected-count)) (error "Counts incorrect, expected:" expected-count " actual:" actual-count))))
+
+; Test raw pointer handling involving virtual inheritance
+(define kini (new-KlassInheritance "KlassInheritanceInput"))
+(checkCount 1)
+(define s (useKlassRawPtr kini))
+(if (not (string=? s "KlassInheritanceInput"))
+  (error "Incorrect string: " s))
+(delete-Klass kini)
+(checkCount 0)
+
+; auto_ptr as input
+(define kin (new-Klass "KlassInput"))
+(checkCount 1)
+(define s (takeKlassAutoPtr kin))
+(checkCount 0)
+(if (not (string=? s "KlassInput"))
+  (error "Incorrect string: " s))
+(if (not (is-nullptr kin))
+  (error "is_nullptr failed"))
+(delete-Klass kin) ; Should not fail, even though already deleted
+(checkCount 0)
+
+(define kin (new-Klass "KlassInput"))
+(checkCount 1)
+(define s (takeKlassAutoPtr kin))
+(checkCount 0)
+(if (not (string=? s "KlassInput"))
+  (error "Incorrect string: " s))
+(if (not (is-nullptr kin))
+  (error "is_nullptr failed"))
+(expect-throw 'misc-error 
+              (takeKlassAutoPtr kin))
+; TODO: check the exception message
+(delete-Klass kin) ; Should not fail, even though already deleted
+(checkCount 0)
+
+(define kin (new-Klass "KlassInput"))
+(define notowned (get-not-owned-ptr kin))
+(expect-throw 'misc-error 
+              (takeKlassAutoPtr notowned))
+; TODO: check the exception message
+(checkCount 1)
+(delete-Klass kin)
+(checkCount 0)
+
+(define kini (new-KlassInheritance "KlassInheritanceInput"))
+(checkCount 1)
+(define s (takeKlassAutoPtr kini))
+(checkCount 0)
+(if (not (string=? s "KlassInheritanceInput"))
+  (error "Incorrect string: " s))
+(if (not (is-nullptr kini))
+  (error "is_nullptr failed"))
+(delete-Klass kini) ; Should not fail, even though already deleted
+(checkCount 0)
+
+; auto_ptr as output
+(define k1 (makeKlassAutoPtr "first"))
+(define k2 (makeKlassAutoPtr "second"))
+(checkCount 2)
+
+(delete-Klass k1)
+(checkCount 1)
+
+(if (not (string=? (Klass-getLabel k2) "second"))
+  (error "wrong object label" ))
+
+(delete-Klass k2)
+(checkCount 0)
+
+(exit 0)

Lib/guile/guile_scm_run.swg

@@ -118,6 +118,8 @@ static SCM swig_symbol = SCM_EOL;
   ( !scm_is_null(x) && SCM_INSTANCEP(x) && scm_is_true(scm_slot_exists_p(x, swig_symbol)) \
       ? scm_slot_ref(x, swig_symbol) : (x) )
 
+SWIGINTERN void SWIG_Guile_MarkPointerNoncollectable(SCM s);
+
 SWIGINTERN SCM
 SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner)
 {
@@ -191,6 +193,7 @@ SWIG_Guile_ConvertPtr(SCM s, void **result, swig_type_info *type, int flags)
   swig_cast_info *cast;
   swig_type_info *from;
   SCM smob = SWIG_Guile_GetSmob(s);
+  int ret = SWIG_ERROR;
 
   if (scm_is_null(smob)) {
     *result = NULL;
@@ -203,22 +206,34 @@ SWIG_Guile_ConvertPtr(SCM s, void **result, swig_type_info *type, int flags)
   } else if (SWIG_Guile_IsValidSmob(smob)) {
     from = (swig_type_info *) SCM_CELL_WORD_2(smob);
     if (!from) return SWIG_ERROR;
+
+    if ((flags & SWIG_POINTER_RELEASE) == SWIG_POINTER_RELEASE) {
+      if ((SCM_CELL_TYPE(smob) == swig_collectable_tag && SCM_CELL_WORD_1(smob) == 0) || SCM_CELL_TYPE(smob) == swig_tag) {
+        return SWIG_ERROR_RELEASE_NOT_OWNED;
+      }
+    }
+
     if (type) {
       cast = SWIG_TypeCheckStruct(from, type);
       if (cast) {
         int newmemory = 0;
         *result = SWIG_TypeCast(cast, (void *) SCM_CELL_WORD_1(smob), &newmemory);
         assert(!newmemory); /* newmemory handling not yet implemented */
-        return SWIG_OK;
+        ret = SWIG_OK;
-      } else {
-        return SWIG_ERROR;
       }
     } else {
       *result = (void *) SCM_CELL_WORD_1(smob);
-      return SWIG_OK;
+      ret = SWIG_OK;
+    }
+
+    if (flags & SWIG_POINTER_DISOWN) {
+      SWIG_Guile_MarkPointerNoncollectable(smob);
+    }
+    if (flags & SWIG_POINTER_CLEAR) {
+      SCM_SET_CELL_WORD_1(smob, 0);
     }
   }
-  return SWIG_ERROR;
+  return ret;
 }
 
 SWIGINTERNINLINE void *

Lib/guile/std_auto_ptr.i

@@ -0,0 +1,33 @@
+/* -----------------------------------------------------------------------------
+ * std_auto_ptr.i
+ *
+ * SWIG library file for handling std::auto_ptr.
+ * Memory ownership is passed from the std::auto_ptr C++ layer to the proxy
+ * class when returning a std::auto_ptr from a function.
+ * Memory ownership is passed from the proxy class to the std::auto_ptr in the
+ * C++ layer when passed as a parameter to a wrapped function.
+ * ----------------------------------------------------------------------------- */
+
+%define %auto_ptr(TYPE)
+%typemap(in, noblock=1) std::auto_ptr< TYPE > (void *argp = 0, int res = 0) {
+  res = SWIG_ConvertPtr($input, &argp, $descriptor(TYPE *), SWIG_POINTER_RELEASE);
+  if (!SWIG_IsOK(res)) {
+    if (res == SWIG_ERROR_RELEASE_NOT_OWNED) {
+      scm_misc_error(FUNC_NAME, "Cannot release ownership as memory is not owned for argument $argnum of type 'TYPE *'", SCM_EOL);
+    } else {
+      %argument_fail(res, "TYPE *", $symname, $argnum);
+    }
+  }
+  $1.reset((TYPE *)argp);
+}
+
+%typemap (out) std::auto_ptr< TYPE > %{
+  %set_output(SWIG_NewPointerObj($1.release(), $descriptor(TYPE *), SWIG_POINTER_OWN));
+%}
+
+%template() std::auto_ptr< TYPE >;
+%enddef
+
+namespace std {
+  template <class T> class auto_ptr {};
+}

Lib/guile/std_unique_ptr.i

@@ -0,0 +1,33 @@
+/* -----------------------------------------------------------------------------
+ * std_unique_ptr.i
+ *
+ * SWIG library file for handling std::unique_ptr.
+ * Memory ownership is passed from the std::unique_ptr C++ layer to the proxy
+ * class when returning a std::unique_ptr from a function.
+ * Memory ownership is passed from the proxy class to the std::unique_ptr in the
+ * C++ layer when passed as a parameter to a wrapped function.
+ * ----------------------------------------------------------------------------- */
+
+%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);
+  if (!SWIG_IsOK(res)) {
+    if (res == SWIG_ERROR_RELEASE_NOT_OWNED) {
+      scm_misc_error(FUNC_NAME, "Cannot release ownership as memory is not owned for argument $argnum of type 'TYPE *'", SCM_EOL);
+    } 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));
+%}
+
+%template() std::unique_ptr< TYPE >;
+%enddef
+
+namespace std {
+  template <class T> class unique_ptr {};
+}