mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-03 11:33:37 +00:00
Fix detection of freed emacs_values (Bug#32479)
* src/emacs-module.c (module_free_global_ref): Compare a value to be freed with all entries of the list. * test/data/emacs-module/mod-test.c (Fmod_test_globref_free): New function. (emacs_module_init): Make it accessible from Lisp. * test/src/emacs-module-tests.el (mod-test-globref-free-test): New test which uses it.
This commit is contained in:
parent
769d0cdaa9
commit
54fb383af6
@ -334,20 +334,20 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
|
||||
Lisp_Object globals = global_env_private.values;
|
||||
Lisp_Object prev = Qnil;
|
||||
ptrdiff_t count = 0;
|
||||
for (Lisp_Object tail = global_env_private.values; CONSP (tail);
|
||||
for (Lisp_Object tail = globals; CONSP (tail);
|
||||
tail = XCDR (tail))
|
||||
{
|
||||
emacs_value global = XSAVE_POINTER (XCAR (globals), 0);
|
||||
emacs_value global = XSAVE_POINTER (XCAR (tail), 0);
|
||||
if (global == ref)
|
||||
{
|
||||
if (NILP (prev))
|
||||
global_env_private.values = XCDR (globals);
|
||||
else
|
||||
XSETCDR (prev, XCDR (globals));
|
||||
XSETCDR (prev, XCDR (tail));
|
||||
return;
|
||||
}
|
||||
++count;
|
||||
prev = globals;
|
||||
prev = tail;
|
||||
}
|
||||
module_abort ("Global value was not found in list of %"pD"d globals",
|
||||
count);
|
||||
|
@ -156,6 +156,24 @@ Fmod_test_globref_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
|
||||
return env->make_global_ref (env, lisp_str);
|
||||
}
|
||||
|
||||
/* Create a few global references from arguments and free them. */
|
||||
static emacs_value
|
||||
Fmod_test_globref_free (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
|
||||
void *data)
|
||||
{
|
||||
emacs_value refs[10];
|
||||
for (int i = 0; i < 10; i++)
|
||||
{
|
||||
refs[i] = env->make_global_ref (env, args[i % nargs]);
|
||||
}
|
||||
for (int i = 0; i < 10; i++)
|
||||
{
|
||||
env->free_global_ref (env, refs[i]);
|
||||
}
|
||||
return env->intern (env, "ok");
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* Return a copy of the argument string where every 'a' is replaced
|
||||
with 'b'. */
|
||||
@ -339,6 +357,7 @@ emacs_module_init (struct emacs_runtime *ert)
|
||||
DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall,
|
||||
1, 1, NULL, NULL);
|
||||
DEFUN ("mod-test-globref-make", Fmod_test_globref_make, 0, 0, NULL, NULL);
|
||||
DEFUN ("mod-test-globref-free", Fmod_test_globref_free, 4, 4, NULL, NULL);
|
||||
DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL);
|
||||
DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL);
|
||||
DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL);
|
||||
|
@ -136,6 +136,9 @@ changes."
|
||||
(garbage-collect) ;; XXX: not enough to really test but it's something..
|
||||
(should (string= ref-str mod-str))))
|
||||
|
||||
(ert-deftest mod-test-globref-free-test ()
|
||||
(should (eq (mod-test-globref-free 1 'a "test" 'b) 'ok)))
|
||||
|
||||
(ert-deftest mod-test-string-a-to-b-test ()
|
||||
(should (string= (mod-test-string-a-to-b "aaa") "bbb")))
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user