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.

4 files changed, 100 insertions, 7 deletions

diff --git a/Lib/mzscheme/mzrun.swg b/Lib/mzscheme/mzrun.swg
index 279073113..fed660dfb 100644
--- a/Lib/mzscheme/mzrun.swg
+++ b/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 *
diff --git a/Lib/mzscheme/std_auto_ptr.i b/Lib/mzscheme/std_auto_ptr.i
new file mode 100644
index 000000000..a903d0063
--- /dev/null
+++ b/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 {};
+}
diff --git a/Lib/mzscheme/std_unique_ptr.i b/Lib/mzscheme/std_unique_ptr.i
new file mode 100644
index 000000000..35386a783
--- /dev/null
+++ b/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 {};
+}
diff --git a/Lib/mzscheme/typemaps.i b/Lib/mzscheme/typemaps.i
index 0fc947d58..ebd0f28da 100644
--- a/Lib/mzscheme/typemaps.i
+++ b/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
  * ------------------------------------------------------------ */