Fix Env's temporary global refs not being freed on non-local exit

This fixes potential memory leaks caused by #3, which was the fix for #2

CHANGELOG.md

@@ -8,6 +8,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).
 - Reduced indirection when calling common built-in subroutines through `Env`.
 - Removed `module_init!`, `export_functions!`,  and their aliases.
 - Replaced `lazy_static` dependency with `once_cell`.
+- Fixed memory leaks caused by the memory safety [fix](https://github.com/ubolonton/emacs-module-rs/pull/3) for [#2](https://github.com/ubolonton/emacs-module-rs/issues/2).
 
 ## [0.12.3] - 2020-02-18
 - Added `Value::car`, `Value::cdr`.
@@ -74,7 +75,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).
 - Upgraded to Rust 2018 edition.
 
 ## [0.5.2] - 2018-09-15
-- New values obtained from `Env` are now GC-protected. This fixes memory issue #2.
+- New values obtained from `Env` are now GC-protected. This fixes memory issue [#2](https://github.com/ubolonton/emacs-module-rs/issues/2).
 
 ## [0.5.1] - 2018-03-03
 - Added `FromLisp` implementation for `Option`.

bin/fn

@@ -8,4 +8,5 @@ source "$here/env.bash"
 FN=$1
 
 $EMACS --batch --directory "$MODULE_DIR" \
+       --module-assertions \
        -l "$PROJECT_ROOT/test-module/tests/main.el" -f "$FN"

bin/fn.ps1

@@ -1,4 +1,5 @@
 $fn = $args[0]
 
 emacs --batch --directory "$env:MODULE_DIR" `
+  --module-assertions `
   -l "$env:PROJECT_ROOT\test-module\tests\main.el" -f "$fn"

src/env.rs

@@ -2,7 +2,8 @@ use std::{cell::RefCell, ffi::CString};
 
 use emacs_module::{emacs_runtime, emacs_env, emacs_value};
 
-use crate::{subr, Value, Result, IntoLisp, call::IntoLispArgs};
+use crate::{subr, error, Value, Result, IntoLisp, call::IntoLispArgs, GlobalRef};
+use std::mem::MaybeUninit;
 
 /// Main point of interaction with the Lisp runtime.
 #[derive(Debug)]
@@ -32,6 +33,14 @@ impl Env {
         self.raw
     }
 
+    // For testing.
+    #[doc(hidden)]
+    pub unsafe fn free_last_protected(&self) -> Result<()>{
+        let gr = GlobalRef::from_raw(*self.protected.borrow().last().unwrap());
+        gr.free(self)?;
+        Ok(())
+    }
+
     pub fn intern(&self, name: &str) -> Result<Value<'_>> {
         unsafe_raw_call_value!(self, intern, CString::new(name)?.as_ptr())
     }
@@ -77,9 +86,25 @@ impl Drop for Env {
     fn drop(&mut self) {
         #[cfg(build = "debug")]
         println!("Unrooting {} values protected by {:?}", self.protected.borrow().len(), self);
+        // If the `defun` returned a non-local exit, we clear it so that `free_global_ref` doesn't
+        // bail out early. Afterwards we restore the non-local exit status and associated data.
+        // It's kind of like an `unwind-protect`.
+        let mut symbol = MaybeUninit::uninit();
+        let mut data = MaybeUninit::uninit();
+        // TODO: Check whether calling non_local_exit_check first makes a difference in performance.
+        let status = self.non_local_exit_get(&mut symbol, &mut data);
+        if status == error::SIGNAL || status == error::THROW {
+            self.non_local_exit_clear();
+        }
         for raw in self.protected.borrow().iter() {
+            // TODO: Do we want to stop if `free_global_ref` returned a non-local exit?
             // Safety: We assume user code doesn't directly call C function `free_global_ref`.
             unsafe_raw_call_no_exit!(self, free_global_ref, *raw);
         }
+        match status {
+            error::SIGNAL => unsafe { self.signal(symbol.assume_init(), data.assume_init()); }
+            error::THROW => unsafe { self.throw(symbol.assume_init(), data.assume_init()); }
+            _ => ()
+        }
     }
 }

src/error.rs

@@ -12,9 +12,9 @@ use emacs_module::*;
 
 // We use const instead of enum, in case Emacs add more exit statuses in the future.
 // See https://github.com/rust-lang/rust/issues/36927
-const RETURN: emacs_funcall_exit = emacs_funcall_exit_return;
-const SIGNAL: emacs_funcall_exit = emacs_funcall_exit_signal;
-const THROW: emacs_funcall_exit = emacs_funcall_exit_throw;
+pub(crate) const RETURN: emacs_funcall_exit = emacs_funcall_exit_return;
+pub(crate) const SIGNAL: emacs_funcall_exit = emacs_funcall_exit_signal;
+pub(crate) const THROW: emacs_funcall_exit = emacs_funcall_exit_throw;
 
 #[derive(Debug)]
 pub struct TempValue {
@@ -213,7 +213,7 @@ impl Env {
         self.call("define-error", (self.intern(name)?, message, parent_symbols))
     }
 
-    fn non_local_exit_get(
+    pub(crate) fn non_local_exit_get(
         &self,
         symbol: &mut MaybeUninit<emacs_value>,
         data: &mut MaybeUninit<emacs_value>,
@@ -222,15 +222,15 @@ impl Env {
         unsafe_raw_call_no_exit!(self, non_local_exit_get, symbol.as_mut_ptr(), data.as_mut_ptr())
     }
 
-    fn non_local_exit_clear(&self) {
+    pub(crate) fn non_local_exit_clear(&self) {
         unsafe_raw_call_no_exit!(self, non_local_exit_clear)
     }
 
     /// # Safety
     ///
     /// The given raw values must still live.
     #[allow(unused_unsafe)]
-    unsafe fn throw(&self, tag: emacs_value, value: emacs_value) -> emacs_value {
+    pub(crate) unsafe fn throw(&self, tag: emacs_value, value: emacs_value) -> emacs_value {
         unsafe_raw_call_no_exit!(self, non_local_exit_throw, tag, value);
         tag
     }
@@ -239,7 +239,7 @@ impl Env {
     ///
     /// The given raw values must still live.
     #[allow(unused_unsafe)]
-    unsafe fn signal(&self, symbol: emacs_value, data: emacs_value) -> emacs_value {
+    pub(crate) unsafe fn signal(&self, symbol: emacs_value, data: emacs_value) -> emacs_value {
         unsafe_raw_call_no_exit!(self, non_local_exit_signal, symbol, data);
         symbol
     }

src/global.rs

@@ -28,6 +28,7 @@ use super::*;
 /// [`free`]: #method.free
 /// [`drop`]: https://doc.rust-lang.org/std/mem/fn.drop.html
 #[derive(Debug)]
+#[repr(transparent)]
 pub struct GlobalRef {
     raw: emacs_value
 }
@@ -40,12 +41,18 @@ impl GlobalRef {
         let env = value.env;
         // TODO: Check whether this really is `no_exit`.
         let raw = unsafe_raw_call_no_exit!(env, make_global_ref, value.raw);
-        // TODO: Check whether raw == self.raw
+        // NOTE: raw != value.raw
+        Self { raw }
+    }
+
+    // For testing.
+    pub(crate) unsafe fn from_raw(raw: emacs_value) -> Self {
         Self { raw }
     }
 
     /// Frees this global reference.
     pub fn free(self, env: &Env) -> Result<()> {
+        // Safety: We assume user code doesn't directly call C function `free_global_ref`.
         unsafe_raw_call!(env, free_global_ref, self.raw)?;
         Ok(())
     }

test-module/src/test_lifetime.rs

@@ -100,3 +100,23 @@ fn gc_after_catching_1<'e>(env: &'e Env, f: Value<'e>) -> Result<Value<'e>> {
         }
     }, print)
 }
+
+/// Attempt to "double-free" a global reference protecting a temporary value.
+///
+/// This function tries to call FUNC before returning.
+///
+/// With a correct implementation of Drop for Env, this function should crash Emacs
+/// when it is run with the '--module-assertions' flag, regardless of whether FUNC
+/// triggered a non-local exit.
+#[defun(mod_in_name = false)]
+fn trigger_double_free_global_ref<'e>(env: &'e Env, func: Value<'e>) -> Result<()> {
+    eprintln!("0 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~");
+    let _ = env.list((1, 2))?;
+    eprintln!("1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~");
+    unsafe { env.free_last_protected()?; }
+    gc(env)?;
+    eprintln!("2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~");
+    env.call("funcall", [func])?;
+    eprintln!("3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~");
+    Ok(())
+}

test-module/tests/main.el

@@ -4,6 +4,9 @@
 (require 'rs-module)
 (require 't)
 
+;;; ----------------------------------------------------------------------------
+;;; Test helpers.
+
 (defmacro t/get-error (&rest body)
   (declare (indent 0))
   `(condition-case err
@@ -15,6 +18,38 @@
          (s (help-split-fundoc docstring sym)))
     (car s)))
 
+(defun t/run-in-sub-process (f-symbol)
+  (let* ((default-directory (getenv "PROJECT_ROOT"))
+         (name (symbol-name f-symbol))
+         (error-file (make-temp-file "destructive-fn"))
+         (exit-code
+          (pcase system-type
+            ((or 'darwin 'gnu/linux)
+             (call-process
+              "bash"
+              ;; If VERBOSE, redirect subprocess's stdout to stderr
+              nil (list (if (getenv "VERBOSE")
+                            '(:file "/dev/stderr")
+                          t)
+                        error-file)
+              nil "./bin/fn" name))
+            ('windows-nt
+             (call-process
+              "powershell"
+              ;; If VERBOSE, redirect subprocess's stdout to stderr
+              nil (list t error-file)
+              nil ".\\bin\\fn.ps1" name))))
+         (error-string
+          (with-temp-buffer
+            (insert-file-contents error-file)
+            (string-trim-right
+             (buffer-substring-no-properties (point-min) (point-max))))))
+    (unless (= exit-code 0)
+      (error "Exit code: %s. Error: %s" exit-code error-string))))
+
+;;; ----------------------------------------------------------------------------
+;;; Type conversion.
+
 (ert-deftest conversion::integers ()
   (should (= (t/inc 3) 4))
   (should (string-match-p (regexp-quote "1+")
@@ -78,6 +113,9 @@
     (should (equal v ["0" "1" "2" "3"]))
     (should-error (t/stringify-num-vector v) :type 'wrong-type-argument)))
 
+;;; ----------------------------------------------------------------------------
+;;; Non-local exits.
+
 (ert-deftest error::propagating-signal ()
   ;; Through Result.
   (should-error (t/error:lisp-divide 1 0) :type 'arith-error)
@@ -117,6 +155,9 @@
   (should (equal (t/get-error (t/error:apply #'t/error:panic '("abc")))
                  '(rust-panic "abc"))))
 
+;;; ----------------------------------------------------------------------------
+;;; Functions.
+
 (ert-deftest calling::through-env ()
   (should (equal '(0 1 2) (t/call-list 3))))
 
@@ -163,6 +204,9 @@
   (should (equal (t/sig 't/error:catch)
                  "(t/error:catch EXPECTED-TAG LAMBDA)")))
 
+;;; ----------------------------------------------------------------------------
+;;; user-ptr.
+
 (ert-deftest transfer::vector ()
 
   (let* ((v1 (t/vector-make 5 6))
@@ -230,46 +274,44 @@
     (should (equal (t/hash-map-set m "a" "2") "1"))
     (should (equal (t/hash-map-get m "a") "2"))))
 
+;;; ----------------------------------------------------------------------------
+;;; Memory safety tests.
+
 ;;; Tests that, if failed, crash the whole process unrecoverably. They will be run under a
 ;;; sub-process Emacs.
 (defmacro destructive-test (name &optional prefix)
   `(ert-deftest ,(intern (if prefix
                              (format "%s::%s" prefix name)
                            (format "%s" name))) ()
-     (let* ((default-directory (getenv "PROJECT_ROOT"))
-            (name ,(format "t/%s" name))
-            (error-file (make-temp-file "destructive-fn"))
-            (exit-code
-             (pcase system-type
-               ((or 'darwin 'gnu/linux)
-                (call-process
-                 "bash"
-                 ;; If VERBOSE, redirect subprocess's stdout to stderr
-                 nil (list (if (getenv "VERBOSE")
-                               '(:file "/dev/stderr")
-                             t)
-                           error-file)
-                 nil "./bin/fn" name))
-               ('windows-nt
-                (call-process
-                 "powershell"
-                 ;; If VERBOSE, redirect subprocess's stdout to stderr
-                 nil (list t error-file)
-                 nil ".\\bin\\fn.ps1" name))))
-            (error-string
-             (with-temp-buffer
-               (insert-file-contents error-file)
-               (string-trim-right
-                (buffer-substring-no-properties (point-min) (point-max))))))
-       (unless (= exit-code 0)
-         (error "Exit code: %s. Error: %s" exit-code error-string)))))
-
-(destructive-test gc-after-new-string lifetime)
-(destructive-test gc-after-uninterning lifetime)
-(destructive-test gc-after-retrieving lifetime)
+     (t/run-in-sub-process (intern ,(format "t/%s" name)))))
 
 ;;; TODO: The way this test is called is a bit convoluted.
 (defun t/gc-after-catching ()
   (t/gc-after-catching-1
    (lambda () (error "abc"))))
+
+(destructive-test gc-after-new-string lifetime)
+(destructive-test gc-after-uninterning lifetime)
+(destructive-test gc-after-retrieving lifetime)
 (destructive-test gc-after-catching lifetime)
+
+;;; ----------------------------------------------------------------------------
+;;; Memory leak tests.
+
+(defun t/free-global-ref-after-normal-return ()
+  (t/trigger-double-free-global-ref
+   (lambda ())))
+
+(defun t/free-global-ref-after-error ()
+  (t/trigger-double-free-global-ref
+   (lambda () (error "This should not show up because Emacs should crash when run with --module-assertions"))))
+
+(ert-deftest global-ref::free-after-normal-return ()
+  (should (string-match-p
+           "Emacs value not found in"
+           (cadr (t/get-error (t/run-in-sub-process 't/free-global-ref-after-normal-return))))))
+
+(ert-deftest global-ref::free-after-error ()
+  (should (string-match-p
+           "Emacs value not found in"
+           (cadr (t/get-error (t/run-in-sub-process 't/free-global-ref-after-error))))))