[PATCH] Ignore pending_signals when checking for quits.

[Philipp Stephani]

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 address@hidden)
 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
address@hidden instead.
address@hidden 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.
+
address@hidden
address@hidden Function enum emacs_process_input_result process_input 
(emacs_env address@hidden)
+This function processes pending input events.  It returns
address@hidden 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,
address@hidden 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
+{
address@hidden@
+
address@hidden@
+
address@hidden@
+};
+
 /* 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 <https://www.gnu.org/licenses/>.  */
 
+#include "config.h"
+
 #include <assert.h>
+#include <errno.h>
+#include <limits.h>
 #include <stdio.h>
 #include <stdlib.h>
-#include <limits.h>
+#include <string.h>
+#include <time.h>
+
 #include <emacs-module.h>
 
+#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)