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)