[R] Run destructors of local C++ objects on SWIG_fail

Arrange that destructors of local C++ objects in the wrapper function
get run on SWIG_fail (which calls Rf_error() which calls longjmp()).

We achieve this by putting almost everything in the function in its
own block, and end that right before Rf_error() at which point those
destructors will get called.

3 files changed, 25 insertions, 1 deletions

diff --git a/CHANGES.current b/CHANGES.current
index e10a46072..ae2fb8ffe 100644
--- a/CHANGES.current
+++ b/CHANGES.current
@@ -8,6 +8,11 @@ Version 4.1.0 (in progress)
 ===========================
 
 2022-10-14: olly
+	    [R] Arrange that destructors of local C++ objects in the wrapper
+	    function get run on SWIG_fail (which calls Rf_error() which calls
+	    longjmp()).
+
+2022-10-14: olly
 	    [Lua] Arrange that destructors of local C++ objects in the wrapper
 	    function get run on SWIG_fail (which calls lua_error() which calls
 	    longjmp()).
diff --git a/Examples/test-suite/r/exception_memory_leak_runme.R b/Examples/test-suite/r/exception_memory_leak_runme.R
index 1f770420a..889fbedc9 100644
--- a/Examples/test-suite/r/exception_memory_leak_runme.R
+++ b/Examples/test-suite/r/exception_memory_leak_runme.R
@@ -14,7 +14,7 @@ unittest(Foo_get_count(), 2);
 invisible(trigger_internal_swig_exception("no problem", a));
 unittest(Foo_get_count(), 2);
 unittest(Foo_get_freearg_count(), 1);
-# SWIG exception introduced
+# SWIG exception introduced (return new object case).
 result <- tryCatch({
   trigger_internal_swig_exception("null", b);
 }, warning = function(w) {
@@ -26,3 +26,14 @@ result <- tryCatch({
 })
 unittest(Foo_get_count(), 2);
 unittest(Foo_get_freearg_count(), 2);
+# SWIG exception introduced (return by value case).
+result <- tryCatch({
+  trigger_internal_swig_exception("null");
+}, 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/Source/Modules/r.cxx b/Source/Modules/r.cxx
index 565145327..526d959f4 100644
--- a/Source/Modules/r.cxx
+++ b/Source/Modules/r.cxx
@@ -1970,6 +1970,13 @@ int R::functionWrapper(Node *n) {
   }
 
   Printv(f->def, ")\n{\n", NIL);
+  // SWIG_fail in R leads to a call to Rf_error() which calls longjmp()
+  // which means the destructors of any live function-local C++ objects won't
+  // get run.  To avoid this happening, we wrap almost everything in the
+  // function in a block, and end that right before Rf_error() at which
+  // point those destructors will get called.
+  if (CPlusPlus) Append(f->def, "{\n");
+
   Printv(sfun->def, ")\n{\n", NIL);
 
 
@@ -2123,6 +2130,7 @@ int R::functionWrapper(Node *n) {
   if (need_cleanup) {
     Printv(f->code, cleanup, NIL);
   }
+  if (CPlusPlus) Append(f->code, "}\n");
   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);