From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Philipp Stephani Newsgroups: gmane.emacs.devel Subject: [PATCH] Ignore pending_signals when checking for quits. Date: Wed, 2 Jan 2019 22:22:18 +0100 Message-ID: <20190102212218.74902-1-phst@google.com> NNTP-Posting-Host: blaine.gmane.org X-Trace: blaine.gmane.org 1546464122 4505 195.159.176.226 (2 Jan 2019 21:22:02 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 2 Jan 2019 21:22:02 +0000 (UTC) Cc: Philipp Stephani To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Jan 02 22:21:58 2019 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1genxe-00012e-4L for ged-emacs-devel@m.gmane.org; Wed, 02 Jan 2019 22:21:58 +0100 Original-Received: from localhost ([127.0.0.1]:47439 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1genzk-0003DH-Te for ged-emacs-devel@m.gmane.org; Wed, 02 Jan 2019 16:24:08 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:33174) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1genyU-00039u-NX for emacs-devel@gnu.org; Wed, 02 Jan 2019 16:22:52 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1genyO-00050T-AY for emacs-devel@gnu.org; Wed, 02 Jan 2019 16:22:50 -0500 Original-Received: from mail-wm1-x343.google.com ([2a00:1450:4864:20::343]:55516) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1genyG-0004ZT-VD for emacs-devel@gnu.org; Wed, 02 Jan 2019 16:22:41 -0500 Original-Received: by mail-wm1-x343.google.com with SMTP id y139so27590550wmc.5 for ; Wed, 02 Jan 2019 13:22:31 -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; bh=cKk9TBlSLodi1g1R0BrH2MJ1CwI1XgaXbKxOSgdcKtY=; b=e9RitT7JleuVa7x7Lfg989xuJJYYXobF6pKahUhunquIpfGDRAtcX58+cMfKJhcLah NVSkzXYGfYxRLnrHUDUMEePcUn+43esA9iELQPgAiCI1SOpRmltAHwtqgRM/4/nsqNz8 fKua6fBnq021ONtzfznsep3CD1u971axPH5COKmuvURsWfiUlXH14ZWRmOp5uUaI7+jL NkF0AvFu7N99DRSmL7GfCKsrKo6c4Fdfl7Qaa6VuwZs6ONHKaHK4VBbITgm3g1vXrxtI uCiLsGi6FkbdxCC8n7JiVmCjkdIPvZEvIJ0G3w76zFATR2wkQXJB2U28eMqkPrng1mhI Wijg== 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; bh=cKk9TBlSLodi1g1R0BrH2MJ1CwI1XgaXbKxOSgdcKtY=; b=s/PcZ5TvBZm7p7whGXeFLwMSh1dHwTLt0mnn0XtQGenPpe6Sgr5qrchSAiYCqQhJt7 hVjOMTGdEb85d5FvW0A/cJbumg0+KCB2KKzaC9IK+UDxaxcrqMkaltHpPhG8SyXF69J4 6hn3sxGCoFaKUihbw/5J9dCYN3+71EVkeOyuLaKGvHTtXL+9yQLp4eZ7gnQg5EKGmSgs qBIfrhXpAlopoDYn7yqTiusmPJbWgJ9PQba7VUJ+wVFFsqkV8FHnYdI36JbZl68bDmpq am2HYnMPtqiN34W+WzTkkpBG3PT6CZN5TEm+gZ2g5BYOxU5A4s3px5Jx/secgjeLYD1C K5HQ== X-Gm-Message-State: AA+aEWZf/EUXjMCx1Qps8uAu2N9txK3tc4++p9m9XRWBQdiv9q0awZUg +x35tr51YjeIjOZ+RhZuFzjesiyL X-Google-Smtp-Source: AFSGD/XItfMhULnk3raEOSBPj4yyFUw+pD61bqO1xDCS8605K44q2lE+1lLKyjCO01NmqUchWpCjzg== X-Received: by 2002:a1c:dc02:: with SMTP id t2mr35308212wmg.78.1546464150319; Wed, 02 Jan 2019 13:22:30 -0800 (PST) Original-Received: from p.fritz.box (p5B13F20B.dip0.t-ipconnect.de. [91.19.242.11]) by smtp.gmail.com with ESMTPSA id n15sm35320851wrt.21.2019.01.02.13.22.29 (version=TLS1_2 cipher=ECDHE-RSA-AES128-SHA bits=128/128); Wed, 02 Jan 2019 13:22:29 -0800 (PST) X-Google-Original-From: Philipp Stephani X-Mailer: git-send-email 2.17.2 (Apple Git-113) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:4864:20::343 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:232108 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. * 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; } 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 . */ #include +#include +#include #include #include -#include +#include +#include + #include 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)