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

Equivalent to Guile implementation.

Slight tweak to proxy ownership was required by adding in
the own member to swig_mz_proxy.

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-18: wsfulton
+            [Racket] Add support for std::unique_ptr in std_unique_ptr.i.
+            Add support for std::auto_ptr in std_auto_ptr.i.
+
 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.

Examples/test-suite/cpp11_std_unique_ptr.i

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

Examples/test-suite/li_std_auto_ptr.i

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

Examples/test-suite/mzscheme/li_std_auto_ptr_runme.scm

@@ -0,0 +1,91 @@
+(load-extension "li_std_auto_ptr.so")
+(require (lib "defmacro.ss"))
+
+; Copied from ../schemerunme/li_std_auto_ptr.scm and modified for exceptions
+
+; Define an equivalent to Guile's gc procedure
+(define-macro (gc)
+  `(collect-garbage 'major))
+
+(define checkCount
+  (lambda (expected-count)
+    (define actual-count (Klass-getTotal-count))
+    (unless (= actual-count expected-count) (error (format "Counts incorrect, expected:~a actual:~a" expected-count  actual-count)))))
+
+; Test raw pointer handling involving virtual inheritance
+(define kini (new-KlassInheritance "KlassInheritanceInput"))
+(checkCount 1)
+(define s (useKlassRawPtr kini))
+(unless (string=? s "KlassInheritanceInput")
+  (error "Incorrect string: " s))
+(set! kini '()) (gc)
+(checkCount 0)
+
+; auto_ptr as input
+(define kin (new-Klass "KlassInput"))
+(checkCount 1)
+(define s (takeKlassAutoPtr kin))
+(checkCount 0)
+(unless (string=? s "KlassInput")
+  (error "Incorrect string: " s))
+(unless (is-nullptr kin)
+  (error "is_nullptr failed"))
+(set! kini '()) (gc) ; Should not fail, even though already deleted
+(checkCount 0)
+
+(define kin (new-Klass "KlassInput"))
+(checkCount 1)
+(define s (takeKlassAutoPtr kin))
+(checkCount 0)
+(unless (string=? s "KlassInput")
+  (error "Incorrect string: " s))
+(unless (is-nullptr kin)
+  (error "is_nullptr failed"))
+
+(define exception_thrown "no exception thrown for kin")
+(with-handlers ([exn:fail? (lambda (exn)
+                             (set! exception_thrown (exn-message exn)))])
+  (takeKlassAutoPtr kin))
+(unless (string=? exception_thrown "takeKlassAutoPtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
+  (error "Wrong or no exception thrown: " exception_thrown))
+(set! kin '()) (gc) ; Should not fail, even though already deleted
+(checkCount 0)
+
+(define kin (new-Klass "KlassInput"))
+(define notowned (get-not-owned-ptr kin))
+(set! exception_thrown "no exception thrown for notowned")
+(with-handlers ([exn:fail? (lambda (exn)
+                             (set! exception_thrown (exn-message exn)))])
+  (takeKlassAutoPtr notowned))
+(unless (string=? exception_thrown "takeKlassAutoPtr: cannot release ownership as memory is not owned for argument 1 of type 'Klass *'")
+  (error "Wrong or no exception thrown: " exception_thrown))
+(checkCount 1)
+(set! kin '()) (gc)
+(checkCount 0)
+
+(define kini (new-KlassInheritance "KlassInheritanceInput"))
+(checkCount 1)
+(define s (takeKlassAutoPtr kini))
+(checkCount 0)
+(unless (string=? s "KlassInheritanceInput")
+  (error "Incorrect string: " s))
+(unless (is-nullptr kini)
+  (error "is_nullptr failed"))
+(set! kini '()) (gc) ; Should not fail, even though already deleted
+(checkCount 0)
+
+; auto_ptr as output
+(define k1 (makeKlassAutoPtr "first"))
+(define k2 (makeKlassAutoPtr "second"))
+(checkCount 2)
+
+(set! k1 '()) (gc)
+(checkCount 1)
+
+(unless (string=? (Klass-getLabel k2) "second")
+  (error "wrong object label" ))
+
+(set! k2 '()) (gc)
+(checkCount 0)
+
+(exit 0)

Examples/test-suite/mzscheme/newobject1_runme.scm

@@ -2,4 +2,8 @@
 
 (require (lib "defmacro.ss"))
 
+; Define an equivalent to Guile's gc procedure
+(define-macro (gc)
+  `(collect-garbage 'major))
+
 (load "../schemerunme/newobject1.scm")

Lib/mzscheme/mzrun.swg

@@ -125,6 +125,7 @@ struct swig_mz_proxy {
   Scheme_Type mztype;
   swig_type_info *type;
   void *object;
+  int own;
 };
 
 static Scheme_Type swig_type;
@@ -135,7 +136,7 @@ mz_free_swig(void *p, void *data) {
   if (SCHEME_NULLP((Scheme_Object*)p) || SCHEME_TYPE((Scheme_Object*)p) != swig_type)
     return;
   if (proxy->type) {
-    if (proxy->type->clientdata) {
+    if (proxy->type->clientdata && proxy->own) {
       ((Scheme_Prim *)proxy->type->clientdata)(1, (Scheme_Object **)&proxy);
     }
   }
@@ -148,7 +149,8 @@ SWIG_MzScheme_NewPointerObj(void *ptr, swig_type_info *type, int owner) {
   new_proxy->mztype = swig_type;
   new_proxy->type = type;
   new_proxy->object = ptr;
-  if (owner) {
+  new_proxy->own = owner & SWIG_POINTER_OWN;
+  if (new_proxy->own) {
     scheme_add_finalizer(new_proxy, mz_free_swig, NULL);
   }
   return (Scheme_Object *) new_proxy;
@@ -157,28 +159,42 @@ SWIG_MzScheme_NewPointerObj(void *ptr, swig_type_info *type, int owner) {
 static int
 SWIG_MzScheme_ConvertPtr(Scheme_Object *s, void **result, swig_type_info *type, int flags) {
   swig_cast_info *cast;
+  int ret = SWIG_ERROR;
 
   if (SCHEME_NULLP(s)) {
     *result = NULL;
     return (flags & SWIG_POINTER_NO_NULL) ? SWIG_NullReferenceError : SWIG_OK;
   } else if (SCHEME_TYPE(s) == swig_type) {
     struct swig_mz_proxy *proxy = (struct swig_mz_proxy *) s;
+
+    if ((flags & SWIG_POINTER_RELEASE) == SWIG_POINTER_RELEASE && !proxy->own) {
+      return SWIG_ERROR_RELEASE_NOT_OWNED;
+    }
+
     if (type) {
       cast = SWIG_TypeCheckStruct(proxy->type, type);
       if (cast) {
         int newmemory = 0;
         *result = SWIG_TypeCast(cast, proxy->object, &newmemory);
         assert(!newmemory); /* newmemory handling not yet implemented */
-        return 0;
+        ret = SWIG_OK;
       } else {
-        return 1;
+        return SWIG_ERROR;
       }
     } else {
       *result = proxy->object;
-      return 0;
+      ret = SWIG_OK;
+    }
+
+    if (flags & SWIG_POINTER_DISOWN) {
+      scheme_subtract_finalizer(proxy, mz_free_swig, NULL);
+      proxy->own = 0;
+    }
+    if (flags & SWIG_POINTER_CLEAR) {
+      proxy->object = 0;
     }
   }
-  return 1;
+  return ret;
 }
 
 static SWIGINLINE void *

Lib/mzscheme/std_auto_ptr.i

@@ -0,0 +1,36 @@
+/* -----------------------------------------------------------------------------
+ * 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 %argument_fail(code, type, name, argn)	scheme_wrong_type(FUNC_NAME, type, argn, argc, argv);
+#define %set_output(obj)                  $result = obj
+
+%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) {
+      scheme_signal_error(FUNC_NAME ": cannot release ownership as memory is not owned for argument $argnum of type 'TYPE *'");
+    } 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/mzscheme/std_unique_ptr.i

@@ -0,0 +1,36 @@
+/* -----------------------------------------------------------------------------
+ * 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 %argument_fail(code, type, name, argn)	scheme_wrong_type(FUNC_NAME, type, argn, argc, argv);
+#define %set_output(obj)                  $result = obj
+
+%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) {
+      scheme_signal_error(FUNC_NAME ": cannot release ownership as memory is not owned for argument $argnum of type 'TYPE *'");
+    } 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 {};
+}

Lib/mzscheme/typemaps.i

@@ -2,6 +2,12 @@
  * typemaps.i
  * ----------------------------------------------------------------------------- */
 
+#define %set_output(obj)                  $result = obj
+#define %set_varoutput(obj)               $result = obj
+#define %argument_fail(code, type, name, argn)	scheme_wrong_type(FUNC_NAME, type, argn, argc, argv);
+#define %as_voidptr(ptr)		(void*)(ptr)
+
+
 /* The MzScheme module handles all types uniformly via typemaps. Here
    are the definitions.  */
 
@@ -291,7 +297,6 @@ REF_MAP(double, SCHEME_REALP, scheme_real_to_double,
 //    $2 = ($2_ltype) temp;
 //}
 
-
 /* ------------------------------------------------------------
  * Typechecking rules
  * ------------------------------------------------------------ */