From c9160bda7889d9e37a9b82ef64bf711ba7e32e41 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 26 Nov 2020 11:37:38 +0000 Subject: [PATCH 1/7] CC Mode: Fix error in cache handling. This fixes bug #43481 * lisp/progmodes/cc-engine.el (c-full-pp-to-literal): Handle correctly END being before HERE by using parse-partial-sexp to get the end of the literal containing HERE. --- lisp/progmodes/cc-engine.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index babe6e74760..01ab253ceba 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -3155,7 +3155,7 @@ comment at the start of cc-engine.el for more info." ((nth 7 s) 'c++) (t 'c))) (setq start (nth 8 s)) - (unless end + (unless (and end (>= end here)) (setq s1 (parse-partial-sexp here (point-max) nil ; TARGETDEPTH nil ; STOPBEFORE From cdc632fbe6e149318147a98cccf1b7af191f2ce8 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Fri, 27 Nov 2020 19:08:55 +0100 Subject: [PATCH 2/7] Fix incorrect handling of module runtime and environment pointers. We used to store module runtime and environment pointers in the static lists Vmodule_runtimes and Vmodule_environments. However, this is incorrect because these objects have to be kept per-thread. With this naive approach, interleaving module function calls in separate threads leads to environments being removed in the wrong order, which in turn can cause local module values to be incorrectly garbage-collected. Instead, turn Vmodule_runtimes and Vmodule_environments into hashtables keyed by the thread objects. The fix is relatively localized and should therefore be safe enough for the release branch. Module assertions now have to walk the pointer list for the current thread, which is more correct since they now only find environments for the current thread. Also add a unit test that exemplifies the problem. It interleaves two module calls in two threads so that the first call ends while the second one is still active. Without this change, this test triggers an assertion failure. * src/emacs-module.c (Fmodule_load, initialize_environment) (finalize_environment, finalize_runtime_unwind): Store runtime and environment pointers in per-thread lists. (syms_of_module): Initialize runtimes and environments hashtables. (module_assert_runtime, module_assert_env, value_to_lisp): Consider only objects for the current thread. (module_gc_hash_table_size, module_hash_push, module_hash_pop): New generic hashtable helper functions. (module_objects, module_push_pointer, module_pop_pointer): New helper functions to main thread-specific lists of runtime and environment pointers. (mark_modules): Mark all environments in all threads. * test/data/emacs-module/mod-test.c (Fmod_test_funcall): New test function. (emacs_module_init): Bind it. * test/src/emacs-module-tests.el (emacs-module-tests--variable): New helper type to guard access to state in a thread-safe way. (emacs-module-tests--wait-for-variable) (emacs-module-tests--change-variable): New helper functions. (emacs-module-tests/interleaved-threads): New unit test. --- src/emacs-module.c | 131 +++++++++++++++++++++++++----- test/data/emacs-module/mod-test.c | 10 +++ test/src/emacs-module-tests.el | 50 ++++++++++++ 3 files changed, 169 insertions(+), 22 deletions(-) diff --git a/src/emacs-module.c b/src/emacs-module.c index a90a9765dbf..89d96839d2f 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -217,6 +217,9 @@ static void module_out_of_memory (emacs_env *); static void module_reset_handlerlist (struct handler **); static bool value_storage_contains_p (const struct emacs_value_storage *, emacs_value, ptrdiff_t *); +static Lisp_Object module_objects (Lisp_Object); +static void module_push_pointer (Lisp_Object, void *); +static void module_pop_pointer (Lisp_Object, void *); static bool module_assertions = false; @@ -1005,7 +1008,8 @@ module_signal_or_throw (struct emacs_env_private *env) } } -/* Live runtime and environment objects, for assertions. */ +/* Live runtime and environment objects, for assertions. These are hashtables + keyed by the thread objects. */ static Lisp_Object Vmodule_runtimes; static Lisp_Object Vmodule_environments; @@ -1046,7 +1050,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, rt->private_members = &rt_priv; rt->get_environment = module_get_environment; - Vmodule_runtimes = Fcons (make_mint_ptr (rt), Vmodule_runtimes); + module_push_pointer (Vmodule_runtimes, rt); ptrdiff_t count = SPECPDL_INDEX (); record_unwind_protect_ptr (finalize_runtime_unwind, rt); @@ -1146,7 +1150,8 @@ module_assert_runtime (struct emacs_runtime *ert) if (! module_assertions) return; ptrdiff_t count = 0; - for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail)) + for (Lisp_Object tail = module_objects (Vmodule_runtimes); CONSP (tail); + tail = XCDR (tail)) { if (xmint_pointer (XCAR (tail)) == ert) return; @@ -1162,7 +1167,7 @@ module_assert_env (emacs_env *env) if (! module_assertions) return; ptrdiff_t count = 0; - for (Lisp_Object tail = Vmodule_environments; CONSP (tail); + for (Lisp_Object tail = module_objects (Vmodule_environments); CONSP (tail); tail = XCDR (tail)) { if (xmint_pointer (XCAR (tail)) == env) @@ -1209,6 +1214,83 @@ module_out_of_memory (emacs_env *env) XCDR (Vmemory_signal_data)); } + +/* Hash table helper functions. */ + +/* Like HASH_TABLE_SIZE, but also works during garbage collection. */ + +static ptrdiff_t +module_gc_hash_table_size (const struct Lisp_Hash_Table *h) +{ + ptrdiff_t size = gc_asize (h->next); + eassert (0 <= size); + return size; +} + +/* Like (push NEWELT (gethash KEY TABLE)). */ + +static void +module_hash_push (Lisp_Object table, Lisp_Object key, Lisp_Object newelt) +{ + /* Inline calls to Fgethash/Fputhash to avoid duplicate hash lookup. */ + struct Lisp_Hash_Table *h = XHASH_TABLE (table); + Lisp_Object hash; + ptrdiff_t i = hash_lookup (h, key, &hash); + if (i >= 0) + set_hash_value_slot (h, i, Fcons (newelt, HASH_VALUE (h, i))); + else + hash_put (h, key, list1 (newelt), hash); +} + +/* Like (pop (gethash KEY TABLE)), but removes KEY from TABLE if the new value + is nil. */ + +static Lisp_Object +module_hash_pop (Lisp_Object table, Lisp_Object key) +{ + /* Inline calls to Fgethash/Fputhash to avoid duplicate hash lookup. */ + struct Lisp_Hash_Table *h = XHASH_TABLE (table); + Lisp_Object hash; + ptrdiff_t i = hash_lookup (h, key, &hash); + eassert (i >= 0); + Lisp_Object value = HASH_VALUE (h, i); + Lisp_Object rest = XCDR (value); + if (NILP (rest)) + hash_remove_from_table(h, key); + else + set_hash_value_slot (h, i, rest); + return XCAR (value); +} + +/* Returns the list of objects for the current thread in TABLE. The keys of + TABLE are thread objects. */ + +static Lisp_Object +module_objects (Lisp_Object table) +{ + return Fgethash (Fcurrent_thread (), table, Qnil); +} + +/* Adds PTR to the front of the list of objects for the current thread in TABLE. + The keys of TABLE are thread objects. */ + +static void +module_push_pointer (Lisp_Object table, void *ptr) +{ + module_hash_push (table, Fcurrent_thread (), make_mint_ptr (ptr)); +} + +/* Removes the first object from the list of objects for the current thread in + TABLE. The keys of TABLE are thread objects. Checks that the first object + is a pointer with value PTR. */ + +static void +module_pop_pointer (Lisp_Object table, void *ptr) +{ + Lisp_Object value = module_hash_pop (table, Fcurrent_thread ()); + eassert (xmint_pointer (value) == ptr); +} + /* Value conversion. */ @@ -1226,7 +1308,7 @@ value_to_lisp (emacs_value v) environments. */ ptrdiff_t num_environments = 0; ptrdiff_t num_values = 0; - for (Lisp_Object environments = Vmodule_environments; + for (Lisp_Object environments = module_objects (Vmodule_environments); CONSP (environments); environments = XCDR (environments)) { emacs_env *env = xmint_pointer (XCAR (environments)); @@ -1326,16 +1408,19 @@ allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage, void mark_modules (void) { - for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem)) - { - emacs_env *env = xmint_pointer (XCAR (tem)); - struct emacs_env_private *priv = env->private_members; - for (struct emacs_value_frame *frame = &priv->storage.initial; - frame != NULL; - frame = frame->next) - for (int i = 0; i < frame->offset; ++i) - mark_object (frame->objects[i].v); - } + const struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_environments); + /* Can't use HASH_TABLE_SIZE because we are in the mark phase of the GC. */ + for (ptrdiff_t i = 0; i < module_gc_hash_table_size (h); ++i) + if (!EQ (HASH_KEY (h, i), Qunbound)) + for (Lisp_Object tem = HASH_VALUE (h, i); CONSP (tem); tem = XCDR (tem)) + { + emacs_env *env = xmint_pointer (XCAR (tem)); + struct emacs_env_private *priv = env->private_members; + for (struct emacs_value_frame *frame = &priv->storage.initial; + frame != NULL; frame = frame->next) + for (int i = 0; i < frame->offset; ++i) + mark_object (frame->objects[i].v); + } } @@ -1390,7 +1475,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->make_time = module_make_time; env->extract_big_integer = module_extract_big_integer; env->make_big_integer = module_make_big_integer; - Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); + module_push_pointer (Vmodule_environments, env); return env; } @@ -1400,8 +1485,7 @@ static void finalize_environment (emacs_env *env) { finalize_storage (&env->private_members->storage); - eassert (xmint_pointer (XCAR (Vmodule_environments)) == env); - Vmodule_environments = XCDR (Vmodule_environments); + module_pop_pointer (Vmodule_environments, env); } static void @@ -1414,9 +1498,8 @@ static void finalize_runtime_unwind (void *raw_ert) { struct emacs_runtime *ert = raw_ert; - eassert (xmint_pointer (XCAR (Vmodule_runtimes)) == ert); - Vmodule_runtimes = XCDR (Vmodule_runtimes); finalize_environment (ert->private_members->env); + module_pop_pointer (Vmodule_runtimes, ert); } @@ -1506,10 +1589,14 @@ syms_of_module (void) Qnil, false); staticpro (&Vmodule_runtimes); - Vmodule_runtimes = Qnil; + Vmodule_runtimes + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, + DEFAULT_REHASH_THRESHOLD, Qnil, false); staticpro (&Vmodule_environments); - Vmodule_environments = Qnil; + Vmodule_environments + = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, + DEFAULT_REHASH_THRESHOLD, Qnil, false); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 8d1b421bb40..528b4b4c582 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -547,6 +547,14 @@ Fmod_test_double (emacs_env *env, ptrdiff_t nargs, emacs_value *args, return result; } +static emacs_value +Fmod_test_funcall (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + assert (0 < nargs); + return env->funcall (env, args[0], nargs - 1, args + 1); +} + /* Lisp utilities for easier readability (simple wrappers). */ /* Provide FEATURE to Emacs. */ @@ -629,6 +637,8 @@ emacs_module_init (struct emacs_runtime *ert) DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, NULL); DEFUN ("mod-test-nanoseconds", Fmod_test_nanoseconds, 1, 1, NULL, NULL); DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL); + DEFUN ("mod-test-funcall", Fmod_test_funcall, 1, emacs_variadic_function, + NULL, NULL); #undef DEFUN diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 9df0b25a0c5..f9bd82e78c6 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -419,4 +419,54 @@ Interactively, you can try hitting \\[keyboard-quit] to quit." (ert-info ((format "input: %d" input)) (should (= (mod-test-double input) (* 2 input)))))) +(cl-defstruct (emacs-module-tests--variable + (:constructor nil) + (:constructor emacs-module-tests--make-variable + (name + &aux + (mutex (make-mutex name)) + (condvar (make-condition-variable mutex name)))) + (:copier nil)) + "A variable that's protected by a mutex." + value + (mutex nil :read-only t :type mutex) + (condvar nil :read-only t :type condition-variable)) + +(defun emacs-module-tests--wait-for-variable (variable desired) + (with-mutex (emacs-module-tests--variable-mutex variable) + (while (not (eq (emacs-module-tests--variable-value variable) desired)) + (condition-wait (emacs-module-tests--variable-condvar variable))))) + +(defun emacs-module-tests--change-variable (variable new) + (with-mutex (emacs-module-tests--variable-mutex variable) + (setf (emacs-module-tests--variable-value variable) new) + (condition-notify (emacs-module-tests--variable-condvar variable) :all))) + +(ert-deftest emacs-module-tests/interleaved-threads () + (let* ((state-1 (emacs-module-tests--make-variable "1")) + (state-2 (emacs-module-tests--make-variable "2")) + (thread-1 + (make-thread + (lambda () + (emacs-module-tests--change-variable state-1 'before-module) + (mod-test-funcall + (lambda () + (emacs-module-tests--change-variable state-1 'in-module) + (emacs-module-tests--wait-for-variable state-2 'in-module))) + (emacs-module-tests--change-variable state-1 'after-module)) + "thread 1")) + (thread-2 + (make-thread + (lambda () + (emacs-module-tests--change-variable state-2 'before-module) + (emacs-module-tests--wait-for-variable state-1 'in-module) + (mod-test-funcall + (lambda () + (emacs-module-tests--change-variable state-2 'in-module) + (emacs-module-tests--wait-for-variable state-1 'after-module))) + (emacs-module-tests--change-variable state-2 'after-module)) + "thread 2"))) + (thread-join thread-1) + (thread-join thread-2))) + ;;; emacs-module-tests.el ends here From f31cacd1ff4e020c0a10fa3da6598b21a6b04988 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 28 Nov 2020 09:21:33 +0200 Subject: [PATCH 3/7] Revert "Fix incorrect handling of module runtime and environment pointers." This reverts commit cdc632fbe6e149318147a98cccf1b7af191f2ce8. Those changes are too significant and non-trivial to be suitable for a release branch at this time. --- src/emacs-module.c | 131 +++++------------------------- test/data/emacs-module/mod-test.c | 10 --- test/src/emacs-module-tests.el | 50 ------------ 3 files changed, 22 insertions(+), 169 deletions(-) diff --git a/src/emacs-module.c b/src/emacs-module.c index 89d96839d2f..a90a9765dbf 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -217,9 +217,6 @@ static void module_out_of_memory (emacs_env *); static void module_reset_handlerlist (struct handler **); static bool value_storage_contains_p (const struct emacs_value_storage *, emacs_value, ptrdiff_t *); -static Lisp_Object module_objects (Lisp_Object); -static void module_push_pointer (Lisp_Object, void *); -static void module_pop_pointer (Lisp_Object, void *); static bool module_assertions = false; @@ -1008,8 +1005,7 @@ module_signal_or_throw (struct emacs_env_private *env) } } -/* Live runtime and environment objects, for assertions. These are hashtables - keyed by the thread objects. */ +/* Live runtime and environment objects, for assertions. */ static Lisp_Object Vmodule_runtimes; static Lisp_Object Vmodule_environments; @@ -1050,7 +1046,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, rt->private_members = &rt_priv; rt->get_environment = module_get_environment; - module_push_pointer (Vmodule_runtimes, rt); + Vmodule_runtimes = Fcons (make_mint_ptr (rt), Vmodule_runtimes); ptrdiff_t count = SPECPDL_INDEX (); record_unwind_protect_ptr (finalize_runtime_unwind, rt); @@ -1150,8 +1146,7 @@ module_assert_runtime (struct emacs_runtime *ert) if (! module_assertions) return; ptrdiff_t count = 0; - for (Lisp_Object tail = module_objects (Vmodule_runtimes); CONSP (tail); - tail = XCDR (tail)) + for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail)) { if (xmint_pointer (XCAR (tail)) == ert) return; @@ -1167,7 +1162,7 @@ module_assert_env (emacs_env *env) if (! module_assertions) return; ptrdiff_t count = 0; - for (Lisp_Object tail = module_objects (Vmodule_environments); CONSP (tail); + for (Lisp_Object tail = Vmodule_environments; CONSP (tail); tail = XCDR (tail)) { if (xmint_pointer (XCAR (tail)) == env) @@ -1214,83 +1209,6 @@ module_out_of_memory (emacs_env *env) XCDR (Vmemory_signal_data)); } - -/* Hash table helper functions. */ - -/* Like HASH_TABLE_SIZE, but also works during garbage collection. */ - -static ptrdiff_t -module_gc_hash_table_size (const struct Lisp_Hash_Table *h) -{ - ptrdiff_t size = gc_asize (h->next); - eassert (0 <= size); - return size; -} - -/* Like (push NEWELT (gethash KEY TABLE)). */ - -static void -module_hash_push (Lisp_Object table, Lisp_Object key, Lisp_Object newelt) -{ - /* Inline calls to Fgethash/Fputhash to avoid duplicate hash lookup. */ - struct Lisp_Hash_Table *h = XHASH_TABLE (table); - Lisp_Object hash; - ptrdiff_t i = hash_lookup (h, key, &hash); - if (i >= 0) - set_hash_value_slot (h, i, Fcons (newelt, HASH_VALUE (h, i))); - else - hash_put (h, key, list1 (newelt), hash); -} - -/* Like (pop (gethash KEY TABLE)), but removes KEY from TABLE if the new value - is nil. */ - -static Lisp_Object -module_hash_pop (Lisp_Object table, Lisp_Object key) -{ - /* Inline calls to Fgethash/Fputhash to avoid duplicate hash lookup. */ - struct Lisp_Hash_Table *h = XHASH_TABLE (table); - Lisp_Object hash; - ptrdiff_t i = hash_lookup (h, key, &hash); - eassert (i >= 0); - Lisp_Object value = HASH_VALUE (h, i); - Lisp_Object rest = XCDR (value); - if (NILP (rest)) - hash_remove_from_table(h, key); - else - set_hash_value_slot (h, i, rest); - return XCAR (value); -} - -/* Returns the list of objects for the current thread in TABLE. The keys of - TABLE are thread objects. */ - -static Lisp_Object -module_objects (Lisp_Object table) -{ - return Fgethash (Fcurrent_thread (), table, Qnil); -} - -/* Adds PTR to the front of the list of objects for the current thread in TABLE. - The keys of TABLE are thread objects. */ - -static void -module_push_pointer (Lisp_Object table, void *ptr) -{ - module_hash_push (table, Fcurrent_thread (), make_mint_ptr (ptr)); -} - -/* Removes the first object from the list of objects for the current thread in - TABLE. The keys of TABLE are thread objects. Checks that the first object - is a pointer with value PTR. */ - -static void -module_pop_pointer (Lisp_Object table, void *ptr) -{ - Lisp_Object value = module_hash_pop (table, Fcurrent_thread ()); - eassert (xmint_pointer (value) == ptr); -} - /* Value conversion. */ @@ -1308,7 +1226,7 @@ value_to_lisp (emacs_value v) environments. */ ptrdiff_t num_environments = 0; ptrdiff_t num_values = 0; - for (Lisp_Object environments = module_objects (Vmodule_environments); + for (Lisp_Object environments = Vmodule_environments; CONSP (environments); environments = XCDR (environments)) { emacs_env *env = xmint_pointer (XCAR (environments)); @@ -1408,19 +1326,16 @@ allocate_emacs_value (emacs_env *env, struct emacs_value_storage *storage, void mark_modules (void) { - const struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_environments); - /* Can't use HASH_TABLE_SIZE because we are in the mark phase of the GC. */ - for (ptrdiff_t i = 0; i < module_gc_hash_table_size (h); ++i) - if (!EQ (HASH_KEY (h, i), Qunbound)) - for (Lisp_Object tem = HASH_VALUE (h, i); CONSP (tem); tem = XCDR (tem)) - { - emacs_env *env = xmint_pointer (XCAR (tem)); - struct emacs_env_private *priv = env->private_members; - for (struct emacs_value_frame *frame = &priv->storage.initial; - frame != NULL; frame = frame->next) - for (int i = 0; i < frame->offset; ++i) - mark_object (frame->objects[i].v); - } + for (Lisp_Object tem = Vmodule_environments; CONSP (tem); tem = XCDR (tem)) + { + emacs_env *env = xmint_pointer (XCAR (tem)); + struct emacs_env_private *priv = env->private_members; + for (struct emacs_value_frame *frame = &priv->storage.initial; + frame != NULL; + frame = frame->next) + for (int i = 0; i < frame->offset; ++i) + mark_object (frame->objects[i].v); + } } @@ -1475,7 +1390,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->make_time = module_make_time; env->extract_big_integer = module_extract_big_integer; env->make_big_integer = module_make_big_integer; - module_push_pointer (Vmodule_environments, env); + Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); return env; } @@ -1485,7 +1400,8 @@ static void finalize_environment (emacs_env *env) { finalize_storage (&env->private_members->storage); - module_pop_pointer (Vmodule_environments, env); + eassert (xmint_pointer (XCAR (Vmodule_environments)) == env); + Vmodule_environments = XCDR (Vmodule_environments); } static void @@ -1498,8 +1414,9 @@ static void finalize_runtime_unwind (void *raw_ert) { struct emacs_runtime *ert = raw_ert; + eassert (xmint_pointer (XCAR (Vmodule_runtimes)) == ert); + Vmodule_runtimes = XCDR (Vmodule_runtimes); finalize_environment (ert->private_members->env); - module_pop_pointer (Vmodule_runtimes, ert); } @@ -1589,14 +1506,10 @@ syms_of_module (void) Qnil, false); staticpro (&Vmodule_runtimes); - Vmodule_runtimes - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + Vmodule_runtimes = Qnil; staticpro (&Vmodule_environments); - Vmodule_environments - = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + Vmodule_environments = Qnil; DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 528b4b4c582..8d1b421bb40 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -547,14 +547,6 @@ Fmod_test_double (emacs_env *env, ptrdiff_t nargs, emacs_value *args, return result; } -static emacs_value -Fmod_test_funcall (emacs_env *env, ptrdiff_t nargs, emacs_value *args, - void *data) -{ - assert (0 < nargs); - return env->funcall (env, args[0], nargs - 1, args + 1); -} - /* Lisp utilities for easier readability (simple wrappers). */ /* Provide FEATURE to Emacs. */ @@ -637,8 +629,6 @@ emacs_module_init (struct emacs_runtime *ert) DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, NULL); DEFUN ("mod-test-nanoseconds", Fmod_test_nanoseconds, 1, 1, NULL, NULL); DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL); - DEFUN ("mod-test-funcall", Fmod_test_funcall, 1, emacs_variadic_function, - NULL, NULL); #undef DEFUN diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index f9bd82e78c6..9df0b25a0c5 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -419,54 +419,4 @@ Interactively, you can try hitting \\[keyboard-quit] to quit." (ert-info ((format "input: %d" input)) (should (= (mod-test-double input) (* 2 input)))))) -(cl-defstruct (emacs-module-tests--variable - (:constructor nil) - (:constructor emacs-module-tests--make-variable - (name - &aux - (mutex (make-mutex name)) - (condvar (make-condition-variable mutex name)))) - (:copier nil)) - "A variable that's protected by a mutex." - value - (mutex nil :read-only t :type mutex) - (condvar nil :read-only t :type condition-variable)) - -(defun emacs-module-tests--wait-for-variable (variable desired) - (with-mutex (emacs-module-tests--variable-mutex variable) - (while (not (eq (emacs-module-tests--variable-value variable) desired)) - (condition-wait (emacs-module-tests--variable-condvar variable))))) - -(defun emacs-module-tests--change-variable (variable new) - (with-mutex (emacs-module-tests--variable-mutex variable) - (setf (emacs-module-tests--variable-value variable) new) - (condition-notify (emacs-module-tests--variable-condvar variable) :all))) - -(ert-deftest emacs-module-tests/interleaved-threads () - (let* ((state-1 (emacs-module-tests--make-variable "1")) - (state-2 (emacs-module-tests--make-variable "2")) - (thread-1 - (make-thread - (lambda () - (emacs-module-tests--change-variable state-1 'before-module) - (mod-test-funcall - (lambda () - (emacs-module-tests--change-variable state-1 'in-module) - (emacs-module-tests--wait-for-variable state-2 'in-module))) - (emacs-module-tests--change-variable state-1 'after-module)) - "thread 1")) - (thread-2 - (make-thread - (lambda () - (emacs-module-tests--change-variable state-2 'before-module) - (emacs-module-tests--wait-for-variable state-1 'in-module) - (mod-test-funcall - (lambda () - (emacs-module-tests--change-variable state-2 'in-module) - (emacs-module-tests--wait-for-variable state-1 'after-module))) - (emacs-module-tests--change-variable state-2 'after-module)) - "thread 2"))) - (thread-join thread-1) - (thread-join thread-2))) - ;;; emacs-module-tests.el ends here From a72db8ab8bfe417d40707be6e791c084509f4abf Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 28 Nov 2020 12:31:43 +0100 Subject: [PATCH 4/7] Make file copying in tramp-gvfs more robust * test/lisp/net/tramp-tests.el (tramp-test11-copy-file) (tramp-test12-rename-file): Do not skip for tramp-gvfs.el. * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file): Add sanity checks. --- lisp/net/tramp-gvfs.el | 25 +++++++++++++++++-------- test/lisp/net/tramp-tests.el | 25 ++++++++++--------------- 2 files changed, 27 insertions(+), 23 deletions(-) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index e369061664a..b457f54fd50 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -800,14 +800,23 @@ file names." (with-tramp-progress-reporter v 0 (format "%s %s to %s" msg-operation filename newname) (unless - (apply - #'tramp-gvfs-send-command v gvfs-operation - (append - (and (eq op 'copy) (or keep-date preserve-uid-gid) - '("--preserve")) - (list - (tramp-gvfs-url-file-name filename) - (tramp-gvfs-url-file-name newname)))) + (and (apply + #'tramp-gvfs-send-command v gvfs-operation + (append + (and (eq op 'copy) (or keep-date preserve-uid-gid) + '("--preserve")) + (list + (tramp-gvfs-url-file-name filename) + (tramp-gvfs-url-file-name newname)))) + ;; Some backends do not return a proper error + ;; code in case of direct copy/move. Apply sanity checks. + (or (not equal-remote) + (tramp-gvfs-send-command + v "gvfs-info" (tramp-gvfs-url-file-name newname)) + (eq op 'copy) + (not (tramp-gvfs-send-command + v "gvfs-info" + (tramp-gvfs-url-file-name filename))))) (if (or (not equal-remote) (and equal-remote diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e42765ba088..26889c9a25b 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2494,9 +2494,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy file to directory. (unwind-protect - ;; FIXME: This fails on my QNAP server, see - ;; /share/Web/owncloud/data/owncloud.log - (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p)) + ;; This doesn't work on FTP. + (unless (tramp--test-ange-ftp-p) (write-region "foo" nil source) (should (file-exists-p source)) (make-directory target) @@ -2520,9 +2519,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy directory to existing directory. (unwind-protect - ;; FIXME: This fails on my QNAP server, see - ;; /share/Web/owncloud/data/owncloud.log - (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p)) + ;; This doesn't work on FTP. + (unless (tramp--test-ange-ftp-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2543,9 +2541,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Copy directory/file to non-existing directory. (unwind-protect - ;; FIXME: This fails on my QNAP server, see - ;; /share/Web/owncloud/data/owncloud.log - (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p)) + ;; This doesn't work on FTP. + (unless (tramp--test-ange-ftp-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2638,9 +2635,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Rename directory to existing directory. (unwind-protect - ;; FIXME: This fails on my QNAP server, see - ;; /share/Web/owncloud/data/owncloud.log - (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p)) + ;; This doesn't work on FTP. + (unless (tramp--test-ange-ftp-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2662,9 +2658,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Rename directory/file to non-existing directory. (unwind-protect - ;; FIXME: This fails on my QNAP server, see - ;; /share/Web/owncloud/data/owncloud.log - (unless (or (tramp--test-ange-ftp-p) (tramp--test-nextcloud-p)) + ;; This doesn't work on FTP. + (unless (tramp--test-ange-ftp-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) From 2cdf1fd261128976c5769b7959e7b98e5425a3fd Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 28 Nov 2020 19:05:18 +0200 Subject: [PATCH 5/7] Fix filing messages when 'rmail-output-reset-deleted-flag' is non-nil * lisp/mail/rmailout.el (rmail-output): Fix off-by-one error in deciding when to advance to the next message under non-nil 'rmail-output-reset-deleted-flag'. (Bug#44839) --- lisp/mail/rmailout.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index 49531eab91e..cfde335b54f 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -579,7 +579,7 @@ from a non-Rmail buffer. In this case, COUNT is ignored." (progn (if rmail-delete-after-output (rmail-delete-message)) - (if (> count 0) + (if (>= count 0) (let ((msgnum rmail-current-message)) (rmail-next-message 1) (eq rmail-current-message (1+ msgnum))))) From 17fa17be3d93fc10f6ca91d738d5056b1b9f1f1e Mon Sep 17 00:00:00 2001 From: Karl Fogel Date: Sat, 28 Nov 2020 18:17:46 -0600 Subject: [PATCH 6/7] Save bookmarks by using `write-file' (bug#12507) Go back to using `write-file' to save bookmarks, instead of using `write-region'. This means numbered backups of the bookmark file may get made again, depending on the value of `bookmark-version-control'. Thanks especially to Drew Adams and Eli Zaretskii for their persistence in tracking down information relevant to this change. --- lisp/bookmark.el | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index e69d9f529cf..4766f61d1bb 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1475,7 +1475,32 @@ for a file, defaulting to the file defined by variable ((eq 'nospecial bookmark-version-control) version-control) (t t)))) (condition-case nil - (write-region (point-min) (point-max) file) + ;; There was a stretch of time (about 15 years) when we + ;; used `write-region' below instead of `write-file', + ;; before going back to `write-file' again. So if you're + ;; considering changing it to `write-region', please see + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=12507. + ;; That bug tells the story of how we first started using + ;; `write-region' in 2005... + ;; + ;; commit a506054af7cd86a63fda996056c09310966f32ef + ;; Author: Karl Fogel + ;; AuthorDate: Sat Nov 12 20:30:22 2005 +0000 + ;; + ;; (bookmark-write-file): Don't visit the + ;; destination file, just write the data to it + ;; using write-region. This is similar to + ;; 2005-05-29T08:36:26Z!rms@gnu.org of saveplace.el, + ;; but with an additional change to avoid visiting + ;; the file in the first place. + ;; + ;; ...and of how further inquiry led us to investigate (in + ;; 2012 and then again in 2020) and eventually decide that + ;; matching the saveplace.el change doesn't make sense for + ;; bookmark.el. Therefore we reverted to `write-file', + ;; which means numbered backups may now be created, + ;; depending on `bookmark-version-control' as per above. + (write-file file) (file-error (message "Can't write %s" file))) (setq bookmark-file-coding-system coding-system-for-write) (kill-buffer (current-buffer)) From 9939c435c108b099d3362ecbfa1cba6cc0bbd8f9 Mon Sep 17 00:00:00 2001 From: Akira Kyle Date: Sun, 29 Nov 2020 11:40:47 +0100 Subject: [PATCH 7/7] Return the correct suffix in eww-make-unique-file-name * lisp/net/eww.el (eww-make-unique-file-name): Return the correct suffix (bug#44936). --- lisp/net/eww.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index d6f850ca3ba..13b90588651 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1661,7 +1661,7 @@ Use link at point if there is one, else the current page's URL." (suffix "")) (when (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file) (setq stem (match-string 1 file) - suffix (match-string 2))) + suffix (match-string 2 file))) (while (file-exists-p (expand-file-name file directory)) (setq file (format "%s(%d)%s" stem count suffix)) (setq count (1+ count)))