From: Philipp Stephani Date: Wed, 2 Jan 2019 21:04:56 +0000 (+0100) Subject: Ignore pending_signals when checking for quits. X-Git-Tag: emacs-27.0.90~3545 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=72ec233f2a1b8a6a9574e61588d0467caf41755c;p=emacs.git Ignore pending_signals when checking for quits. pending_signals is often set if no quit is pending. This results in bugs in module code if the module returns but no quit is actually pending. As a better alternative, add a new process_input environment function for Emacs 27. That function processes signals (like maybe_quit). * configure.ac: Add module snippet for Emacs 27. * src/module-env-27.h: New file. * src/emacs-module.h.in: Add process_input function to environment interface. * src/emacs-module.c (module_should_quit): Use QUITP macro to check whether the caller should quit. (module_process_input): New function. (initialize_environment): Use it. * src/eval.c: Remove obsolete comment. * test/data/emacs-module/mod-test.c (signal_wrong_type_argument) (signal_errno): New helper functions. (Fmod_test_sleep_until): New test module function. * test/src/emacs-module-tests.el (mod-test-sleep-until): New unit test. * doc/lispref/internals.texi (Module Misc): Document process_input. --- diff --git a/configure.ac b/configure.ac index c26eb6d1e89..110ea2909a9 100644 --- a/configure.ac +++ b/configure.ac @@ -3689,8 +3689,10 @@ AC_SUBST(MODULES_SUFFIX) AC_CONFIG_FILES([src/emacs-module.h]) AC_SUBST_FILE([module_env_snippet_25]) AC_SUBST_FILE([module_env_snippet_26]) +AC_SUBST_FILE([module_env_snippet_27]) module_env_snippet_25="$srcdir/src/module-env-25.h" module_env_snippet_26="$srcdir/src/module-env-26.h" +module_env_snippet_27="$srcdir/src/module-env-27.h" ### Use -lpng if available, unless '--with-png=no'. HAVE_PNG=no diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 3fbff266add..56465126f41 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1623,7 +1623,27 @@ purpose. @deftypefn Function bool should_quit (emacs_env *@var{env}) This function returns @code{true} if the user wants to quit. In that case, we recommend that your module function aborts any on-going -processing and returns as soon as possible. +processing and returns as soon as possible. In most cases, use +@code{process_input} instead. +@end deftypefn + +To process input events in addition to checking whether the user wants +to quit, use the following function, which is available since Emacs +27.1. + +@anchor{process_input} +@deftypefn Function enum emacs_process_input_result process_input (emacs_env *@var{env}) +This function processes pending input events. It returns +@code{emacs_process_input_quit} if the user wants to quit or an error +occurred while processing signals. In that case, we recommend that +your module function aborts any on-going processing and returns as +soon as possible. If the module code may continue running, +@code{process_input} returns @code{emacs_process_input_continue}. The +return value is @code{emacs_process_input_continue} if and only if +there is no pending nonlocal exit in @code{env}. If the module +continues after calling @code{process_input}, global state such as +variable values and buffer content may have been modified in arbitrary +ways. @end deftypefn @node Module Nonlocal diff --git a/etc/NEWS b/etc/NEWS index 67e376d9b38..8acbf6d3a7f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1614,6 +1614,9 @@ given frame supports resizing. This is currently supported on GNUish hosts and on modern versions of MS-Windows. +** New module environment function 'process_input' to process user +input while module code is running. + * Changes in Emacs 27.1 on Non-Free Operating Systems diff --git a/src/emacs-module.c b/src/emacs-module.c index cbab0234201..b70d6cea812 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -671,13 +671,21 @@ module_vec_size (emacs_env *env, emacs_value vec) return ASIZE (lvec); } -/* This function should return true if and only if maybe_quit would do - anything. */ +/* This function should return true if and only if maybe_quit would + quit. */ static bool module_should_quit (emacs_env *env) { MODULE_FUNCTION_BEGIN_NO_CATCH (false); - return (! NILP (Vquit_flag) && NILP (Vinhibit_quit)) || pending_signals; + return QUITP; +} + +static enum emacs_process_input_result +module_process_input (emacs_env *env) +{ + MODULE_FUNCTION_BEGIN (emacs_process_input_quit); + maybe_quit (); + return emacs_process_input_continue; } @@ -1082,6 +1090,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->vec_get = module_vec_get; env->vec_size = module_vec_size; env->should_quit = module_should_quit; + env->process_input = module_process_input; Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); return env; } diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index 4c5286f6257..009d1583fef 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -47,7 +47,7 @@ extern "C" { #endif /* Current environment. */ -typedef struct emacs_env_26 emacs_env; +typedef struct emacs_env_27 emacs_env; /* Opaque pointer representing an Emacs Lisp value. BEWARE: Do not assume NULL is a valid value! */ @@ -83,6 +83,16 @@ enum emacs_funcall_exit emacs_funcall_exit_throw = 2 }; +/* Possible return values for emacs_env.process_input. */ +enum emacs_process_input_result +{ + /* Module code may continue */ + emacs_process_input_continue = 0, + + /* Module code should return control to Emacs as soon as possible. */ + emacs_process_input_quit = 1 +}; + struct emacs_env_25 { @module_env_snippet_25@ @@ -95,6 +105,15 @@ struct emacs_env_26 @module_env_snippet_26@ }; +struct emacs_env_27 +{ +@module_env_snippet_25@ + +@module_env_snippet_26@ + +@module_env_snippet_27@ +}; + /* Every module should define a function as follows. */ extern int emacs_module_init (struct emacs_runtime *ert) EMACS_NOEXCEPT diff --git a/src/eval.c b/src/eval.c index b094fc2e663..b6cdfc911d0 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1575,10 +1575,7 @@ process_quit_flag (void) If quit-flag is set to `kill-emacs' the SIGINT handler has received a request to exit Emacs when it is safe to do. - When not quitting, process any pending signals. - - If you change this function, also adapt module_should_quit in - emacs-module.c. */ + When not quitting, process any pending signals. */ void maybe_quit (void) diff --git a/src/module-env-27.h b/src/module-env-27.h new file mode 100644 index 00000000000..b491b60fbbc --- /dev/null +++ b/src/module-env-27.h @@ -0,0 +1,4 @@ + /* Processes pending input events and returns whether the module + function should quit. */ + enum emacs_process_input_result (*process_input) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL (1); diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 98242e85baf..47ea159d0e7 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -17,12 +17,20 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +#include "config.h" + #include +#include +#include #include #include -#include +#include +#include + #include +#include "timespec.h" + int plugin_is_GPL_compatible; #if INTPTR_MAX <= 0 @@ -299,6 +307,64 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args, return env->funcall (env, env->intern (env, "garbage-collect"), 0, NULL); } +static void +signal_wrong_type_argument (emacs_env *env, const char *predicate, + emacs_value arg) +{ + emacs_value symbol = env->intern (env, "wrong-type-argument"); + emacs_value elements[2] = {env->intern (env, predicate), arg}; + emacs_value data = env->funcall (env, env->intern (env, "list"), 2, elements); + env->non_local_exit_signal (env, symbol, data); +} + +static void +signal_errno (emacs_env *env, const char *function) +{ + const char *message = strerror (errno); + emacs_value message_value = env->make_string (env, message, strlen (message)); + emacs_value symbol = env->intern (env, "file-error"); + emacs_value elements[2] + = {env->make_string (env, function, strlen (function)), message_value}; + emacs_value data = env->funcall (env, env->intern (env, "list"), 2, elements); + env->non_local_exit_signal (env, symbol, data); +} + +/* A long-running operation that occasionally calls `should_quit' or + `process_input'. */ + +static emacs_value +Fmod_test_sleep_until (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + assert (nargs == 2); + const double until_seconds = env->extract_float (env, args[0]); + if (env->non_local_exit_check (env)) + return NULL; + if (until_seconds <= 0) + { + signal_wrong_type_argument (env, "cl-plusp", args[0]); + return NULL; + } + const bool process_input = env->is_not_nil (env, args[1]); + const struct timespec until = dtotimespec (until_seconds); + const struct timespec amount = make_timespec(0, 10000000); + while (true) + { + const struct timespec now = current_timespec (); + if (timespec_cmp (now, until) >= 0) + break; + if (nanosleep (&amount, NULL) && errno != EINTR) + { + signal_errno (env, "nanosleep"); + return NULL; + } + if ((process_input + && env->process_input (env) == emacs_process_input_quit) + || env->should_quit (env)) + return NULL; + } + return env->intern (env, "finished"); +} /* Lisp utilities for easier readability (simple wrappers). */ @@ -367,6 +433,7 @@ emacs_module_init (struct emacs_runtime *ert) 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); + DEFUN ("mod-test-sleep-until", Fmod_test_sleep_until, 2, 2, NULL, NULL); #undef DEFUN diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index e4593044ecd..e30980b5993 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -289,4 +289,24 @@ Return A + B" (should (member '(provide . mod-test) entries)) (should (member '(defun . mod-test-sum) entries)))) +(ert-deftest mod-test-sleep-until () + "Check that `mod-test-sleep-until' either returns normally or quits. +Interactively, you can try hitting \\[keyboard-quit] to quit." + (dolist (arg '(nil t)) + ;; Guard against some caller setting `inhibit-quit'. + (with-local-quit + (condition-case nil + (should (eq (with-local-quit + ;; Because `inhibit-quit' is nil here, the next + ;; form either quits or returns `finished'. + (mod-test-sleep-until + ;; Interactively, run for 5 seconds to give the + ;; user time to quit. In batch mode, run only + ;; briefly since the user can't quit. + (float-time (time-add nil (if noninteractive 0.1 5))) + ;; should_quit or process_input + arg)) + 'finished)) + (quit))))) + ;;; emacs-module-tests.el ends here