bug#55628: debug-timer-check fails on macOS 11.6.6

["Mattias Engdegård" <mattiase@acm.org>]

[-- Attachment #1: Type: text/plain, Size: 189 bytes --]

Attached is the final patch (just the two previously combined with a commit message).

Would someone please double-check that it works on a platform other than macOS before I push it?


[-- Attachment #2: 0001-Fix-atimer-setting-and-overdue-expiration-bug-55628.patch --]
[-- Type: application/octet-stream, Size: 4192 bytes --]

From 671716186fc6d2506d06e85485faad405a365e6a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Mon, 30 May 2022 12:25:19 +0200
Subject: [PATCH] Fix atimer setting and overdue expiration (bug#55628)

* src/atimer.c (set_alarm): If the atimer has already expired, signal
it right away instead of postponing it further.  Previously this could
occur repeatedly, blocking atimers indefinitely.
Also only use `alarm` as fallback if `setitimer` is unavailable, not
both at the same time (which makes no sense, and they both typically
use the same mechanism behind the curtains).

* test/src/eval-tests.el (eval-tests/funcall-with-delayed-message):
New test, verifying proper functioning of funcall-with-delayed-message
which also serves as test for this bug (which also caused
debug-timer-check to fail, but that test is only run when Emacs is
built with enable-checking).
---
 src/atimer.c           | 33 ++++++++++++++++-----------------
 test/src/eval-tests.el | 27 +++++++++++++++++++++++++++
 2 files changed, 43 insertions(+), 17 deletions(-)

diff --git a/src/atimer.c b/src/atimer.c
index 1c6c881fc0..c26904e1f0 100644
--- a/src/atimer.c
+++ b/src/atimer.c
@@ -297,11 +297,6 @@ set_alarm (void)
 {
   if (atimers)
     {
-#ifdef HAVE_SETITIMER
-      struct itimerval it;
-#endif
-      struct timespec now, interval;
-
 #ifdef HAVE_ITIMERSPEC
       if (0 <= timerfd || alarm_timer_ok)
 	{
@@ -337,20 +332,24 @@ set_alarm (void)
 	}
 #endif
 
-      /* Determine interval till the next timer is ripe.
-	 Don't set the interval to 0; this disables the timer.  */
-      now = current_timespec ();
-      interval = (timespec_cmp (atimers->expiration, now) <= 0
-		  ? make_timespec (0, 1000 * 1000)
-		  : timespec_sub (atimers->expiration, now));
+      /* Determine interval till the next timer is ripe.  */
+      struct timespec now = current_timespec ();
+      if (timespec_cmp (atimers->expiration, now) <= 0)
+	{
+	  /* Timer is (over)due -- just trigger the signal right way.  */
+	  raise (SIGALRM);
+	}
+      else
+	{
+	  struct timespec interval = timespec_sub (atimers->expiration, now);
 
 #ifdef HAVE_SETITIMER
-
-      memset (&it, 0, sizeof it);
-      it.it_value = make_timeval (interval);
-      setitimer (ITIMER_REAL, &it, 0);
-#endif /* not HAVE_SETITIMER */
-      alarm (max (interval.tv_sec, 1));
+	  struct itimerval it = {.it_value = make_timeval (interval)};
+	  setitimer (ITIMER_REAL, &it, 0);
+#else
+	  alarm (max (interval.tv_sec, 1));
+#endif
+	}
     }
 }
 
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index e4230c10ef..1b2ad99360 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -240,4 +240,31 @@ eval-tests/backtrace-in-batch-mode/demoted-errors
       (should (equal (string-trim (buffer-string))
                      "Error: (error \"Boo\")")))))
 
+(ert-deftest eval-tests/funcall-with-delayed-message ()
+  ;; Check that `funcall-with-delayed-message' displays its message before
+  ;; its function terminates iff the timeout is short enough.
+
+  ;; This also serves as regression test for bug#55628 where a short
+  ;; timeout was rounded up to the next whole second.
+  (dolist (params '((0.8 0.4)
+                    (0.1 0.8)))
+    (let ((timeout (nth 0 params))
+          (work-time (nth 1 params)))
+      (ert-info ((prin1-to-string params) :prefix "params: ")
+        (with-current-buffer "*Messages*"
+          (let ((inhibit-read-only t))
+            (erase-buffer))
+          (let ((stop (+ (float-time) work-time)))
+            (funcall-with-delayed-message
+             timeout "timed out"
+             (lambda ()
+               (while (< (float-time) stop))
+               (message "finished"))))
+          (let ((expected-messages
+                 (if (< timeout work-time)
+                     "timed out\nfinished"
+                   "finished")))
+            (should (equal (string-trim (buffer-string))
+                           expected-messages))))))))
+
 ;;; eval-tests.el ends here
-- 
2.32.0 (Apple Git-132)