Fix R memory leak on exception
There is a possible memory leak in case the SWIG_exception_fail macro
is called. The problem is related to its definition that call the
function Rf_warning. This function (as well as Rf_error) involves
a longjmp over C++ destructors on the stack. Thus, all the objects
allocated on the heap are not freed.
Closes #914
diff --git a/Examples/test-suite/r/Makefile.in b/Examples/test-suite/r/Makefile.in
index 33e9d90..98835b9 100644
--- a/Examples/test-suite/r/Makefile.in
+++ b/Examples/test-suite/r/Makefile.in
@@ -18,6 +18,7 @@
CPP_TEST_CASES += \
r_double_delete \
+ r_memory_leak \
r_overload_array \
r_sexp \
r_overload_comma \
diff --git a/Examples/test-suite/r/r_memory_leak_runme.R b/Examples/test-suite/r/r_memory_leak_runme.R
new file mode 100644
index 0000000..ef6533a
--- /dev/null
+++ b/Examples/test-suite/r/r_memory_leak_runme.R
@@ -0,0 +1,26 @@
+clargs <- commandArgs(trailing=TRUE)
+source(file.path(clargs[1], "unittest.R"))
+
+dyn.load(paste("r_memory_leak", .Platform$dynlib.ext, sep=""))
+source("r_memory_leak.R")
+cacheMetaData(1)
+
+a <- Foo();
+unittest(Foo_get_count(), 1);
+b <- Foo();
+unittest(Foo_get_count(), 2);
+
+# Normal behaviour
+invisible(trigger_internal_swig_exception("no problem", a));
+unittest(Foo_get_count(), 2);
+# SWIG exception introduced
+result <- tryCatch({
+ trigger_internal_swig_exception("null", b);
+}, warning = function(w) {
+ # print(" Hum... We received a warning, but this should be an error");
+ unittest(1,0);
+}, error = function(e) {
+ # print(" Gotcha!");
+ unittest(1,1);
+})
+unittest(Foo_get_count(), 2);
diff --git a/Examples/test-suite/r_memory_leak.i b/Examples/test-suite/r_memory_leak.i
new file mode 100644
index 0000000..d490de5
--- /dev/null
+++ b/Examples/test-suite/r_memory_leak.i
@@ -0,0 +1,40 @@
+%module r_memory_leak
+
+%include <std_string.i>
+
+%typemap(in) Foo* foo
+{
+ $1 = new Foo;
+}
+%typemap(freearg) Foo* foo
+{
+ printf(" \" Object deleted\"\n");
+ delete $1;
+}
+%typemap(out) Foo* verify_no_memory_leak
+{
+ if ($1 == NULL)
+ SWIG_exception_fail(SWIG_RuntimeError, "Let's see how the bindings manage this exception!");
+}
+%typemap(scoerceout) Foo*
+ %{ if (!is.null($result) && !is.logical($result)) {$result <- new("$R_class", ref=$result) ;} %}
+
+%inline %{
+ #include <string>
+
+ class Foo {
+ static unsigned count;
+ public:
+ Foo() { ++count; }
+ ~Foo() { --count; }
+ static unsigned get_count() { return count; }
+ };
+
+ unsigned Foo::count = 0;
+
+ static Foo* trigger_internal_swig_exception(const std::string& message, Foo* foo)
+ {
+ return (message == "null") ? NULL : foo;
+ };
+
+%}
diff --git a/Lib/r/rfragments.swg b/Lib/r/rfragments.swg
index b89212b..c3b40a9 100644
--- a/Lib/r/rfragments.swg
+++ b/Lib/r/rfragments.swg
@@ -1,7 +1,3 @@
-#define SWIG_Error(code, msg) Rf_warning(msg); return Rf_ScalarLogical(NA_LOGICAL)
-
-#define SWIG_fail return Rf_ScalarLogical(NA_LOGICAL)
-
/* for raw pointers */
#define SWIG_ConvertPtr(oc, ptr, ty, flags) SWIG_R_ConvertPtr(oc, ptr, ty, flags)
#define SWIG_ConvertFunctionPtr(oc, ptr, ty) SWIG_R_ConvertPtr(oc, ptr, ty, 0)
diff --git a/Lib/r/rrun.swg b/Lib/r/rrun.swg
index c341321..a84bb77 100644
--- a/Lib/r/rrun.swg
+++ b/Lib/r/rrun.swg
@@ -1,3 +1,46 @@
+#include <stdarg.h> // va_list, va_start, va_end
+#include <stdio.h> // vsnprintf
+
+/* Last error */
+static int SWIG_lasterror_code = 0;
+static char SWIG_lasterror_msg[1024];
+SWIGRUNTIME void SWIG_Error(int code, const char *format, ...) {
+ va_list arg;
+ SWIG_lasterror_code = code;
+ va_start(arg, format);
+ vsnprintf(SWIG_lasterror_msg, sizeof(SWIG_lasterror_msg), format, arg);
+ va_end(arg);
+}
+
+SWIGRUNTIME const char* SWIG_ErrorType(int code) {
+ switch (code) {
+ case SWIG_MemoryError:
+ return "SWIG:MemoryError";
+ case SWIG_IOError:
+ return "SWIG:IOError";
+ case SWIG_RuntimeError:
+ return "SWIG:RuntimeError";
+ case SWIG_IndexError:
+ return "SWIG:IndexError";
+ case SWIG_TypeError:
+ return "SWIG:TypeError";
+ case SWIG_DivisionByZero:
+ return "SWIG:DivisionByZero";
+ case SWIG_OverflowError:
+ return "SWIG:OverflowError";
+ case SWIG_SyntaxError:
+ return "SWIG:SyntaxError";
+ case SWIG_ValueError:
+ return "SWIG:ValueError";
+ case SWIG_SystemError:
+ return "SWIG:SystemError";
+ case SWIG_AttributeError:
+ return "SWIG:AttributeError";
+ }
+ return "SWIG:UnknownError";
+}
+
+#define SWIG_fail goto fail
/* Remove global namespace pollution */
#if !defined(SWIG_NO_R_NO_REMAP)
diff --git a/Source/Modules/r.cxx b/Source/Modules/r.cxx
index 84076b9..addcf8b 100644
--- a/Source/Modules/r.cxx
+++ b/Source/Modules/r.cxx
@@ -1985,7 +1985,9 @@
for (p = l; p;) {
if ((tm = Getattr(p, "tmap:freearg"))) {
Replaceall(tm, "$source", Getattr(p, "lname"));
- Printv(cleanup, tm, "\n", NIL);
+ if (tm && (Len(tm) != 0)) {
+ Printv(cleanup, tm, "\n", NIL);
+ }
p = Getattr(p, "tmap:freearg:next");
} else {
p = nextSibling(p);
@@ -2066,8 +2068,10 @@
}
/* Output cleanup code */
- Printv(f->code, cleanup, NIL);
- Delete(cleanup);
+ int need_cleanup = Len(cleanup) != 0;
+ if (need_cleanup) {
+ Printv(f->code, cleanup, NIL);
+ }
/* Look to see if there is any newfree cleanup code */
if (GetFlag(n, "feature:new")) {
@@ -2124,7 +2128,18 @@
if (destructor)
Printv(f->code, "R_ClearExternalPtr(self);\n", NIL);
- Printv(f->code, "return r_ans;\n}\n", NIL);
+ Printv(f->code, "return r_ans;\n", NIL);
+
+ /* Error handling code */
+ Printv(f->code, "fail: SWIGUNUSED;\n", NIL);
+ if (need_cleanup) {
+ Printv(f->code, cleanup, NIL);
+ }
+ Printv(f->code, " Rf_error(\"%s %s\", SWIG_ErrorType(SWIG_lasterror_code), SWIG_lasterror_msg);\n", NIL);
+ Printv(f->code, " return R_NilValue;\n", NIL);
+ Delete(cleanup);
+
+ Printv(f->code, "}\n", NIL);
Printv(sfun->code, "\n}", NIL);
/* Substitute the function name */
