master 6355a3e: Fix subtle bug when checking liveness of module values.

[Philipp Stephani]

branch: master
commit 6355a3ec62f43c9b99d483982ff851d32dd78891
Author: Philipp Stephani <phst@google.com>
Commit: Philipp Stephani <phst@google.com>

    Fix subtle bug when checking liveness of module values.
    
    We can't simply look up the Lisp object in the global reference table
    because an invalid local and a valid global reference might refer to
    the same object.  Instead, we have to test the address of the global
    reference against the stored references.
    
    * src/emacs-module.c (module_global_reference_p): New helper function.
    (value_to_lisp): Use it.
    
    * test/data/emacs-module/mod-test.c
    (Fmod_test_invalid_store_copy): New test module function.
    (emacs_module_init): Export it.
    
    * test/src/emacs-module-tests.el
    (module--test-assertions--load-non-live-object-with-global-copy):
    New unit test.
---
 src/emacs-module.c                | 27 ++++++++++++++++++++++++---
 test/data/emacs-module/mod-test.c | 18 ++++++++++++++++++
 test/src/emacs-module-tests.el    | 18 ++++++++++++++++++
 3 files changed, 60 insertions(+), 3 deletions(-)

diff --git a/src/emacs-module.c b/src/emacs-module.c
index c47ea9c..02563a4 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -78,6 +78,7 @@ To add a new module function, proceed as follows:
 #include "emacs-module.h"
 
 #include <stdarg.h>
+#include <stdbool.h>
 #include <stddef.h>
 #include <stdint.h>
 #include <stdlib.h>
@@ -400,6 +401,28 @@ XMODULE_GLOBAL_REFERENCE (Lisp_Object o)
   return XUNTAG (o, Lisp_Vectorlike, struct module_global_reference);
 }
 
+/* Returns whether V is a global reference.  Only used to check module
+   assertions.  If V is not a global reference, increment *N by the
+   number of global references (for debugging output).  */
+
+static bool
+module_global_reference_p (emacs_value v, ptrdiff_t *n)
+{
+  struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
+  /* Note that we can't use `hash_lookup' because V might be a local
+     reference that's identical to some global reference.  */
+  for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
+    {
+      if (!EQ (HASH_KEY (h, i), Qunbound)
+          && &XMODULE_GLOBAL_REFERENCE (HASH_VALUE (h, i))->value == v)
+        return true;
+    }
+  /* Only used for debugging, so we don't care about overflow, just
+     make sure the operation is defined.  */
+  INT_ADD_WRAPV (*n, h->count, n);
+  return false;
+}
+
 static emacs_value
 module_make_global_ref (emacs_env *env, emacs_value value)
 {
@@ -1277,10 +1300,8 @@ value_to_lisp (emacs_value v)
           ++num_environments;
         }
       /* Also check global values.  */
-      struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
-      if (hash_lookup (h, v->v, NULL) != -1)
+      if (module_global_reference_p (v, &num_values))
         goto ok;
-      INT_ADD_WRAPV (num_values, h->count, &num_values);
       module_abort (("Emacs value not found in %"pD"d values "
                     "of %"pD"d environments"),
                     num_values, num_environments);
diff --git a/test/data/emacs-module/mod-test.c 
b/test/data/emacs-module/mod-test.c
index 1e64bcd..437faae 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -306,6 +306,22 @@ Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, 
emacs_value *args,
   return invalid_stored_value;
 }
 
+/* The next function works in conjunction with the two previous ones.
+   It stows away a copy of the object created by
+   `Fmod_test_invalid_store' in a global reference.  Module assertions
+   should still detect the invalid load of the local reference.  */
+
+static emacs_value global_copy_of_invalid_stored_value;
+
+static emacs_value
+Fmod_test_invalid_store_copy (emacs_env *env, ptrdiff_t nargs,
+                              emacs_value *args, void *data)
+{
+  emacs_value local = Fmod_test_invalid_store (env, 0, NULL, NULL);
+  return global_copy_of_invalid_stored_value
+         = env->make_global_ref (env, local);
+}
+
 /* An invalid finalizer: Finalizers are run during garbage collection,
    where Lisp code can't be executed.  -module-assertions tests for
    this case.  */
@@ -684,6 +700,8 @@ emacs_module_init (struct emacs_runtime *ert)
   DEFUN ("mod-test-vector-fill", Fmod_test_vector_fill, 2, 2, NULL, NULL);
   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-store-copy", Fmod_test_invalid_store_copy, 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);
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 411b450..7ed9ecf 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -272,6 +272,24 @@ must evaluate to a regular expression string."
     (mod-test-invalid-store)
     (mod-test-invalid-load)))
 
+(ert-deftest module--test-assertions--load-non-live-object-with-global-copy ()
+  "Check that -module-assertions verify that non-live objects aren't accessed.
+This differs from `module--test-assertions-load-non-live-object'
+in that it stows away a global reference.  The module assertions
+should nevertheless detect the invalid load."
+  (skip-unless (or (file-executable-p mod-test-emacs)
+                   (and (eq system-type 'windows-nt)
+                        (file-executable-p (concat mod-test-emacs ".exe")))))
+  ;; This doesn't yet cause undefined behavior.
+  (should (eq (mod-test-invalid-store-copy) 123))
+  (module--test-assertion (rx "Emacs value not found in "
+                              (+ digit) " values of "
+                              (+ digit) " environments\n")
+    ;; Storing and reloading a local value causes undefined behavior,
+    ;; which should be detected by the module assertions.
+    (mod-test-invalid-store-copy)
+    (mod-test-invalid-load)))
+
 (ert-deftest module--test-assertions--call-emacs-from-gc ()
   "Check that -module-assertions prevents calling Emacs functions
 during garbage collection."