unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] Ignore pending_signals when checking for quits.
@ 2019-01-02 21:22 Philipp Stephani
  2019-01-03 14:03 ` Eli Zaretskii
  2019-01-03 14:09 ` Eli Zaretskii
  0 siblings, 2 replies; 15+ messages in thread
From: Philipp Stephani @ 2019-01-02 21:22 UTC (permalink / raw)
  To: emacs-devel; +Cc: 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.

* src/emacs-module.c (module_should_quit): Use QUITP macro to check
whether the caller should quit.

* 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.
---
 src/emacs-module.c                |  6 +--
 src/eval.c                        |  5 +--
 test/data/emacs-module/mod-test.c | 65 ++++++++++++++++++++++++++++++-
 test/src/emacs-module-tests.el    | 17 ++++++++
 4 files changed, 85 insertions(+), 8 deletions(-)

diff --git a/src/emacs-module.c b/src/emacs-module.c
index e695a3d2e6..a00487137c 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -671,13 +671,13 @@ 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;
 }
 
 \f
diff --git a/src/eval.c b/src/eval.c
index c64a40b955..a73477a581 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1572,10 +1572,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/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index 98242e85ba..dddd0cddbc 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -18,9 +18,13 @@ 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 <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>
 
 int plugin_is_GPL_compatible;
@@ -299,6 +303,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'.  */
+
+static emacs_value
+Fmod_test_sleep_until (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+                       void *data)
+{
+  assert (nargs == 1);
+  double until = env->extract_float (env, args[0]);
+  if (env->non_local_exit_check (env))
+    return NULL;
+  if (until <= 0)
+    {
+      signal_wrong_type_argument (env, "cl-plusp", args[0]);
+      return NULL;
+    }
+  while (true)
+    {
+      struct timespec now;
+      if (clock_gettime (CLOCK_REALTIME, &now))
+        {
+          signal_errno (env, "clock_gettime");
+          return NULL;
+        }
+      if (now.tv_sec + (double) now.tv_nsec / 1e9 >= until)
+        break;
+      struct timespec amount = {.tv_sec = 0, .tv_nsec = 10000000};
+      if (nanosleep (&amount, NULL) && errno != EINTR)
+        {
+          signal_errno (env, "nanosleep");
+          return NULL;
+        }
+      if (env->should_quit (env))
+        return NULL;
+    }
+  return env->intern (env, "finished");
+}
 
 /* Lisp utilities for easier readability (simple wrappers).  */
 
@@ -367,6 +429,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, 1, 1, NULL, NULL);
 
 #undef DEFUN
 
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index e4593044ec..9334f951fe 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -289,4 +289,21 @@ 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."
+  ;; 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)))))
+                    'finished))
+      (quit))))
+
 ;;; emacs-module-tests.el ends here
-- 
2.17.2 (Apple Git-113)




^ permalink raw reply related	[flat|nested] 15+ messages in thread

end of thread, other threads:[~2019-08-07 16:22 UTC | newest]

Thread overview: 15+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-01-02 21:22 [PATCH] Ignore pending_signals when checking for quits Philipp Stephani
2019-01-03 14:03 ` Eli Zaretskii
2019-02-10 18:49   ` Philipp Stephani
2019-02-10 19:40     ` Eli Zaretskii
2019-02-10 19:46       ` Philipp Stephani
2019-02-10 20:15         ` Eli Zaretskii
2019-02-11 20:17           ` Philipp Stephani
2019-02-13 15:28             ` Eli Zaretskii
2019-02-24 21:51               ` Philipp Stephani
2019-04-19 19:06                 ` Philipp Stephani
2019-04-19 20:15                   ` Eli Zaretskii
2019-04-28 18:19                     ` Philipp Stephani
2019-04-28 18:42                       ` Eli Zaretskii
2019-08-07 16:22                         ` Philipp Stephani
2019-01-03 14:09 ` Eli Zaretskii

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).