Module assertions: check for garbage collections

It's technically possible to write a user pointer finalizer that calls
into Emacs module functions.  This would be disastrous because it
would allow arbitrary Lisp code to run during garbage collection.
Therefore extend the module assertions to check for this case.

* src/emacs-module.c (module_assert_thread): Also check whether a
garbage collection is in progress.

* test/data/emacs-module/mod-test.c (invalid_finalizer)
(Fmod_test_invalid_finalizer): New test module functions.
(emacs_module_init): Register new test function.

* test/src/emacs-module-tests.el (module--test-assertion)
(module--with-temp-directory): New helper macros.
(module--test-assertions--load-non-live-object): Rename existing
unit test, use helper macros.
(module--test-assertions--call-emacs-from-gc): New unit test.

2 files changed, 81 insertions, 29 deletions

diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index eee9466c5d6..42e1c2bd4ae 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -235,6 +235,27 @@ Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
   return invalid_stored_value;
 }
 
+/* An invalid finalizer: Finalizers are run during garbage collection,
+   where Lisp code can’t be executed.  -module-assertions tests for
+   this case.  */
+
+static emacs_env *current_env;
+
+static void
+invalid_finalizer (void *ptr)
+{
+  current_env->intern (current_env, "nil");
+}
+
+static emacs_value
+Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+                             void *data)
+{
+  current_env = env;
+  env->make_user_ptr (env, invalid_finalizer, NULL);
+  return env->funcall (env, env->intern (env, "garbage-collect"), 0, NULL);
+}
+
 
 /* Lisp utilities for easier readability (simple wrappers).  */
 
@@ -300,6 +321,8 @@ emacs_module_init (struct emacs_runtime *ert)
   DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL);
   DEFUN ("mod-test-invalid-store", Fmod_test_invalid_store, 0, 0, NULL, NULL);
   DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL);
+  DEFUN ("mod-test-invalid-finalizer", Fmod_test_invalid_finalizer, 0, 0,
+         NULL, NULL);
 
 #undef DEFUN
 
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index a4994b6223b..988a7a178c6 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -182,37 +182,66 @@ changes."
   (should (equal (help-function-arglist #'mod-test-sum)
                  '(arg1 arg2))))
 
-(ert-deftest module--test-assertions ()
-  "Check that -module-assertions work."
+(defmacro module--with-temp-directory (name &rest body)
+  "Bind NAME to the name of a temporary directory and evaluate BODY.
+NAME must be a symbol.  Delete the temporary directory after BODY
+exits normally or non-locally.  NAME will be bound to the
+directory name (not the directory file name) of the temporary
+directory."
+  (declare (indent 1))
+  (cl-check-type name symbol)
+  `(let ((,name (file-name-as-directory
+                 (make-temp-file "emacs-module-test" :directory))))
+     (unwind-protect
+         (progn ,@body)
+       (delete-directory ,name :recursive))))
+
+(defmacro module--test-assertion (pattern &rest body)
+  "Test that PATTERN matches the assertion triggered by BODY.
+Run Emacs as a subprocess, load the test module `mod-test-file',
+and evaluate BODY.  Verify that Emacs aborts and prints a module
+assertion message that matches PATTERN.  PATTERN is evaluated and
+must evaluate to a regular expression string."
+  (declare (indent 1))
+  ;; To contain any core dumps.
+  `(module--with-temp-directory tempdir
+     (with-temp-buffer
+       (let* ((default-directory tempdir)
+              (status (call-process mod-test-emacs nil t nil
+                                    "-batch" "-Q" "-module-assertions" "-eval"
+                                    ,(prin1-to-string
+                                      `(progn
+                                         (require 'mod-test ,mod-test-file)
+                                         ,@body)))))
+         (should (stringp status))
+         ;; eg "Aborted" or "Abort trap: 6"
+         (should (string-prefix-p "Abort" status))
+         (search-backward "Emacs module assertion: ")
+         (goto-char (match-end 0))
+         (should (string-match-p ,pattern
+                                 (buffer-substring-no-properties
+                                  (point) (point-max))))))))
+
+(ert-deftest module--test-assertions--load-non-live-object ()
+  "Check that -module-assertions verify that non-live objects
+aren’t accessed."
   (skip-unless (file-executable-p mod-test-emacs))
   ;; This doesn’t yet cause undefined behavior.
   (should (eq (mod-test-invalid-store) 123))
-  ;; To contain any core dumps.
-  (let ((tempdir (make-temp-file "emacs-module-test" t)))
-    (unwind-protect
-        (with-temp-buffer
-          (should (string-match-p
-                   "Abort" ; eg "Aborted" or "Abort trap: 6"
-                   (let ((default-directory tempdir))
-                     (call-process mod-test-emacs nil t nil
-                                   "-batch" "-Q" "-module-assertions" "-eval"
-                                   (prin1-to-string
-                                    `(progn
-                                       (require 'mod-test ,mod-test-file)
-                                       ;; Storing and reloading a local
-                                       ;; value causes undefined behavior,
-                                       ;; which should be detected by the
-                                       ;; module assertions.
-                                       (mod-test-invalid-store)
-                                       (mod-test-invalid-load)))))))
-          (search-backward "Emacs module assertion:")
-          (should (string-match-p (rx bos "Emacs module assertion: "
-                                      "Emacs value not found in "
-                                      (+ digit) " values of "
-                                      (+ digit) " environments" eos)
-                                  (buffer-substring-no-properties
-                                   (line-beginning-position)
-                                   (line-end-position)))))
-      (delete-directory tempdir t))))
+  (module--test-assertion (rx "Emacs value not found in "
+                              (+ digit) " values of "
+                              (+ digit) " environments\n" eos)
+    ;; Storing and reloading a local value causes undefined behavior,
+    ;; which should be detected by the module assertions.
+    (mod-test-invalid-store)
+    (mod-test-invalid-load)))
+
+(ert-deftest module--test-assertions--call-emacs-from-gc ()
+  "Check that -module-assertions prevents calling Emacs functions
+during garbage collection."
+  (skip-unless (file-executable-p mod-test-emacs))
+  (module--test-assertion
+      (rx "Module function called during garbage collection\n" eos)
+    (mod-test-invalid-finalizer)))
 
 ;;; emacs-module-tests.el ends here