From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: Philipp Stephani Newsgroups: gmane.emacs.devel Subject: [PATCH] Ignore pending_signals when checking for quits. Date: Mon, 11 Feb 2019 21:17:39 +0100 Message-ID: <20190211201739.25229-1-phst@google.com> References: <83y36nl7rl.fsf@gnu.org> Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="59418"; mail-complaints-to="usenet@blaine.gmane.org" Cc: Philipp Stephani To: emacs-devel@gnu.org, eliz@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Feb 11 21:20:52 2019 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:256) (Exim 4.89) (envelope-from ) id 1gtI4R-000FLf-VM for ged-emacs-devel@m.gmane.org; Mon, 11 Feb 2019 21:20:52 +0100 Original-Received: from localhost ([127.0.0.1]:55661 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gtI4N-0005lT-Fx for ged-emacs-devel@m.gmane.org; Mon, 11 Feb 2019 15:20:50 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:46328) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gtI4A-0005eL-Gy for emacs-devel@gnu.org; Mon, 11 Feb 2019 15:20:36 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gtI1b-0001u0-Ty for emacs-devel@gnu.org; Mon, 11 Feb 2019 15:17:59 -0500 Original-Received: from mail-wr1-x442.google.com ([2a00:1450:4864:20::442]:42749) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gtI1b-0001pe-Fe; Mon, 11 Feb 2019 15:17:55 -0500 Original-Received: by mail-wr1-x442.google.com with SMTP id q18so180128wrx.9; Mon, 11 Feb 2019 12:17:52 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references; bh=RX2eR9XzYmo9OU9Qdo7Td9P7kbF9efCPF7yjEgpXD9E=; b=t/IYfxRF1GCU4pSWvx0aAlzcfS9zD62Hj0Mbv1sO5Ca+Ftmta/sH11svj6fxcFvZ76 8PHzUIAiCuedX19OfclcEWBUtWJp2t0Z8YpuJxop1UAZNUaU9vMLusUY8V1E7TfeVAcd lbXjG+2h8KVE0MH0umlSK9rdvdu3SmgWaO772ILxPD9VMTOW+4XvwBxyzitV+G6NMYDm H1KCOhgZEFb1YolvcE301i7VMIH0JHhM8RiR/PgWRPuIW5r74jeLnV96bvf2b1cYrYM1 GuO7/JvMxqYY/4GOx5K/gNKAFAKL7bVak3RlSJLJdGWZXOjFvWyepVcXWwqczmxTazAB qYcg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references; bh=RX2eR9XzYmo9OU9Qdo7Td9P7kbF9efCPF7yjEgpXD9E=; b=nXnyf+BCuDkSIwh20BC4Yey1/lVjaiPTGXtccU1sZNlR1B5eDaUkIAsIWUvw+Ekovb ZbuOUccq40fG5xVNpU9JkqhRY5O1ZQQMUBSSH68U1IQhXK0aKpZXABQ6i1mQcX83uSKZ YO+UTFxKavJkRsAmVdPnDTPb2q1iNbdz8vnefWP01Gyo0Q6tXwa2YQySQE/68ONc0T2i PTJU+fGDgRyV6LBuy/KJ5SX0z/+HSOGZOEbW7lRIS4rp5e7XLE+d01zvqoODdLAxDqdE e8ul3lmvb0wVpJKJqrrGrrnEmzWUIgcI06DN2001DY3FL1dwRcS1ZLx/Nv+kQabk9jY4 neSg== X-Gm-Message-State: AHQUAuYE/jjIoHs3/wWlZOfPyGGJkw1YVwIZX/+HclG09l9q19PtH3lV mkABzINcV4Nvrljirmxc8C3PI7p9 X-Google-Smtp-Source: AHgI3Ib1+Wj0mbDq0RhjldN3O7h93CUNfkNADa7c7JMAN1M/fqKffov9PcWYUn+d0p0AWbBhkXomjw== X-Received: by 2002:adf:e3d1:: with SMTP id k17mr9434852wrm.143.1549916270732; Mon, 11 Feb 2019 12:17:50 -0800 (PST) Original-Received: from p.cm.cablesurf.de (85.233.42.145.dynamic.cablesurf.de. [85.233.42.145]) by smtp.gmail.com with ESMTPSA id f8sm9864473wrv.41.2019.02.11.12.17.49 (version=TLS1_2 cipher=ECDHE-RSA-AES128-SHA bits=128/128); Mon, 11 Feb 2019 12:17:50 -0800 (PST) X-Google-Original-From: Philipp Stephani X-Mailer: git-send-email 2.17.2 (Apple Git-113) In-Reply-To: <83y36nl7rl.fsf@gnu.org> X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:4864:20::442 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:233226 Archived-At: 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. --- configure.ac | 2 + doc/lispref/internals.texi | 22 +++++++++- etc/NEWS | 3 ++ src/emacs-module.c | 15 +++++-- src/emacs-module.h.in | 21 +++++++++- src/eval.c | 5 +-- src/module-env-27.h | 4 ++ test/data/emacs-module/mod-test.c | 69 ++++++++++++++++++++++++++++++- test/src/emacs-module-tests.el | 20 +++++++++ 9 files changed, 151 insertions(+), 10 deletions(-) create mode 100644 src/module-env-27.h diff --git a/configure.ac b/configure.ac index 58579008f3..3318f04a5a 100644 --- a/configure.ac +++ b/configure.ac @@ -3689,8 +3689,10 @@ AC_DEFUN 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 3fbff266ad..56465126f4 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1623,7 +1623,27 @@ Module Misc @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 75c8dc0b8e..08e2e0c728 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1564,6 +1564,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 cbab023420..b70d6cea81 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 4c5286f625..009d1583fe 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 b094fc2e66..b6cdfc911d 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 0000000000..b491b60fbb --- /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 98242e85ba..47ea159d0e 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 e4593044ec..e30980b599 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -289,4 +289,24 @@ module--test-assertion (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 -- 2.17.2 (Apple Git-113)