GNU bug report logs - #61741
30.0.50; [PATCH] Reset errant timers

Previous Next

Package: emacs;

Reported by: dick.r.chiang <at> gmail.com

Date: Thu, 23 Feb 2023 22:05:02 UTC

Severity: normal

Tags: patch

Found in version 30.0.50

Done: Po Lu <luangruo <at> yahoo.com>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 61741 in the body.
You can then email your comments to 61741 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to bug-gnu-emacs <at> gnu.org:
bug#61741; Package emacs. (Thu, 23 Feb 2023 22:05:02 GMT) Full text and rfc822 format available.

Acknowledgement sent to dick.r.chiang <at> gmail.com:
New bug report received and forwarded. Copy sent to bug-gnu-emacs <at> gnu.org. (Thu, 23 Feb 2023 22:05:02 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: dick.r.chiang <at> gmail.com
To: bug-gnu-emacs <bug-gnu-emacs <at> gnu.org>
Subject: 30.0.50; [PATCH] Reset errant timers
Date: Thu, 23 Feb 2023 13:54:46 -0500
[0001-Reset-errant-timers.patch (text/x-diff, inline)]
From 5f8dd26a2e521864ba5ca6c61e5a89ac5db223e0 Mon Sep 17 00:00:00 2001
From: dickmao <dick.r.chiang <at> gmail.com>
Date: Thu, 23 Feb 2023 13:30:33 -0500
Subject: [PATCH] Reset errant timers

It's always irked me that a repeated timer, should it error
under debug-on-error, enters a zombie state.

emacs -Q \
 --eval "(setq debugger (lambda (&rest _args) \
                           (run-at-time 1 nil \
                              (function list-timers)) \
                           (top-level)))" \
 --eval "(setq debug-on-error t)" \
 --eval "(run-at-time nil 0.5 (lambda () (error \"foo\"))))"

* lisp/emacs-lisp/timer-list.el (timer, list-timers,
timer-list-mode): time-subtract prefers a smaller subtrahend.
* lisp/emacs-lisp/timer.el (timer, timerp): A timer
does not begin life already triggered.
(timer--check, timer--time-setter, timer-set-function, cancel-timer):
Make weak sauce less weak.
(cancel-timer-internal): Remove.
(timer-event-handler): Rewrite.
(run-with-idle-timer): Brevity is clarity.
(internal-timer-start-idle): Why test indeed.
* lisp/frame.el (blink-cursor--start-idle-timer):
Everyone else simply says "t".
* lisp/jit-lock.el (jit-lock-stealth-fontify):
Demangle interfaces.
* lisp/time.el (display-time-event-handler):
Prefer descriptive getters.
* src/fns.c (Fcopy_sequence): Stay safe.
* src/keyboard.c (trigger_timer, timer_check_2, timer_check):
Brevity is clarity.
* test/lisp/emacs-lisp/timer-tests.el (timer-test-debug-on-error-delay,
timer-test-debug-on-error-timer, timer-test-debug-on-error-0,
timer-test-debug-on-error-1): Test.
---
 lisp/emacs-lisp/timer-list.el       |  34 ++--
 lisp/emacs-lisp/timer.el            | 257 ++++++++-------------------
 lisp/frame.el                       |   2 +-
 lisp/jit-lock.el                    |   2 +-
 lisp/time.el                        |   4 +-
 src/fns.c                           |   2 +-
 src/keyboard.c                      | 261 +++++++---------------------
 test/lisp/emacs-lisp/timer-tests.el |  26 +++
 8 files changed, 189 insertions(+), 399 deletions(-)

diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index b9a171adc07..1e1c22b8f77 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -24,6 +24,8 @@

 ;;; Code:

+(require 'timer)
+
 (defvar cl-print-compiled)
 (defvar cl-print-compiled-button)

@@ -41,23 +43,29 @@ list-timers
             nil
             `[ ;; Idle.
               ,(propertize
-                (if (aref timer 7) "   *" " ")
+                (if (timer--idle-delay timer) "   *" " ")
                 'help-echo "* marks idle timers"
                 'timer timer)
               ;; Next time.
               ,(propertize
-                (let ((time (list (aref timer 1)
-				  (aref timer 2)
-				  (aref timer 3))))
-                  (format "%12s"
-                          (format-seconds "%dd %hh %mm %z%,1ss"
-			                  (float-time
-			                   (if (aref timer 7)
-			                       time
-			                     (time-subtract time nil))))))
+                (let* ((time (timer--time timer))
+                       (idle-p (timer--idle-delay timer))
+                       (inverted-p (and (not idle-p)
+                                        (time-less-p time nil)))
+                       (formatted (format-seconds
+                                   "%1dd %2hh %2mm %z%,1ss"
+		                   (float-time
+		                    (if idle-p
+			                time
+                                      (if inverted-p
+                                          (time-subtract nil time)
+			                (time-subtract time nil)))))))
+                  (when (equal formatted "0.0s")
+                    (setq inverted-p nil))
+                  (format "%13s" (concat (if inverted-p "-" "") formatted)))
                 'help-echo "Time until next invocation")
               ;; Repeat.
-              ,(let ((repeat (aref timer 4)))
+              ,(let ((repeat (timer--repeat-delay timer)))
                  (cond
                   ((numberp repeat)
                    (propertize
@@ -73,7 +81,7 @@ list-timers
                 (let ((cl-print-compiled 'static)
                       (cl-print-compiled-button nil)
                       (print-escape-newlines t))
-                  (cl-prin1-to-string (aref timer 5)))
+                  (cl-prin1-to-string (timer--function timer)))
                 'help-echo "Function called by timer")]))
          (append timer-list timer-idle-list)))
   (tabulated-list-print))
@@ -94,7 +102,7 @@ timer-list-mode
   (setq-local revert-buffer-function #'list-timers)
   (setq tabulated-list-format
         '[("Idle" 6 timer-list--idle-predicate)
-          ("Next" 12 timer-list--next-predicate :right-align t :pad-right 1)
+          ("Next" 13 timer-list--next-predicate :right-align t :pad-right 1)
           ("Repeat" 12 timer-list--repeat-predicate :right-align t :pad-right 1)
           ("Function" 10 timer-list--function-predicate)]))

diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 7544279d8aa..097290c7b4f 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -28,18 +28,13 @@
 ;;; Code:

 (eval-when-compile (require 'cl-lib))
-
-;; If you change this structure, you also have to change `timerp'
-;; (below) and decode_timer in keyboard.c.
 (cl-defstruct (timer
                (:constructor nil)
                (:copier nil)
                (:constructor timer--create ())
-               (:type vector)
+               (:type vector) ; undefines timer-p (see timerp)
                (:conc-name timer--))
-  ;; nil if the timer is active (waiting to be triggered),
-  ;; non-nil if it is inactive ("already triggered", in theory).
-  (triggered t)
+  triggered
   ;; Time of next trigger: for normal timers, absolute time, for idle timers,
   ;; time relative to idle-start.
   high-seconds low-seconds usecs
@@ -61,18 +56,23 @@ timer-create
   ;; hardcode the shape of timers in other .elc files.
   (timer--create))

-(defun timerp (object)
-  "Return t if OBJECT is a timer."
-  (and (vectorp object)
-       ;; Timers are now ten elements, but old .elc code may have
-       ;; shorter versions of `timer-create'.
-       (<= 9 (length object) 10)))
+(defsubst timerp (object)
+  "Return t if OBJECT appears to be a timer.
+As the timer struct does not implicitly define a timer-p
+predicate (since it explicitly shunts to a vector type), we
+attempt an heuristic."
+  (and (vectorp object) (= (length object) 10)))

 (defsubst timer--check (timer)
-  (or (timerp timer) (signal 'wrong-type-argument (list #'timerp timer))))
+  (or (and (timerp timer)
+           (integerp (timer--high-seconds timer))
+           (integerp (timer--low-seconds timer))
+           (integerp (timer--usecs timer))
+           (integerp (timer--psecs timer))
+           (timer--function timer))
+      (error "Invalid timer %S" timer)))

 (defun timer--time-setter (timer time)
-  (timer--check timer)
   (let ((lt (time-convert time 'list)))
     (setf (timer--high-seconds timer) (nth 0 lt))
     (setf (timer--low-seconds timer) (nth 1 lt))
@@ -153,100 +153,29 @@ timer-inc-time

 (defun timer-set-function (timer function &optional args)
   "Make TIMER call FUNCTION with optional ARGS when triggering."
-  (timer--check timer)
   (setf (timer--function timer) function)
   (setf (timer--args timer) args)
   timer)
-
-(defun timer--activate (timer &optional triggered-p reuse-cell idle)
-  (let ((timers (if idle timer-idle-list timer-list))
-	last)
-    (cond
-     ((not (and (timerp timer)
-	        (integerp (timer--high-seconds timer))
-	        (integerp (timer--low-seconds timer))
-	        (integerp (timer--usecs timer))
-	        (integerp (timer--psecs timer))
-	        (timer--function timer)))
-      (error "Invalid or uninitialized timer"))
-     ;; FIXME: This is not reliable because `idle-delay' is only set late,
-     ;; by `timer-activate-when-idle' :-(
-     ;;((not (eq (not idle)
-     ;;          (not (timer--idle-delay timer))))
-     ;; (error "idle arg %S out of sync with idle-delay field of timer: %S"
-     ;;        idle timer))
-     ((memq timer timers)
-      (error "Timer already activated"))
-     (t
-      ;; Skip all timers to trigger before the new one.
-      (while (and timers (timer--time-less-p (car timers) timer))
-	(setq last timers
-	      timers (cdr timers)))
-      (if reuse-cell
-	  (progn
-	    (setcar reuse-cell timer)
-	    (setcdr reuse-cell timers))
-	(setq reuse-cell (cons timer timers)))
-      ;; Insert new timer after last which possibly means in front of queue.
-      (setf (cond (last (cdr last))
-                  (idle timer-idle-list)
-                  (t    timer-list))
-            reuse-cell)
-      (setf (timer--triggered timer) triggered-p)
-      (setf (timer--idle-delay timer) idle)
-      nil))))
-
-(defun timer-activate (timer &optional triggered-p reuse-cell)
-  "Insert TIMER into `timer-list'.
-If TRIGGERED-P is t, make TIMER inactive (put it on the list, but
-mark it as already triggered).  To remove it, use `cancel-timer'.
-
-REUSE-CELL, if non-nil, is a cons cell to reuse when inserting
-TIMER into `timer-list' (usually a cell removed from that list by
-`cancel-timer-internal'; using this reduces consing for repeat
-timers).  If nil, allocate a new cell."
-  (timer--activate timer triggered-p reuse-cell nil))
-
-(defun timer-activate-when-idle (timer &optional dont-wait reuse-cell)
-  "Insert TIMER into `timer-idle-list'.
-This arranges to activate TIMER whenever Emacs is next idle.
-If optional argument DONT-WAIT is non-nil, set TIMER to activate
-immediately \(see below), or at the right time, if Emacs is
-already idle.
-
-REUSE-CELL, if non-nil, is a cons cell to reuse when inserting
-TIMER into `timer-idle-list' (usually a cell removed from that
-list by `cancel-timer-internal'; using this reduces consing for
-repeat timers).  If nil, allocate a new cell.
-
-Using non-nil DONT-WAIT is not recommended when activating an
-idle timer from an idle timer handler, if the timer being
-activated has an idleness time that is smaller or equal to
-the time of the current timer.  That's because the activated
-timer will fire right away."
-  (timer--activate timer (not dont-wait) reuse-cell 'idle))
+
+(defsubst timer-activate (timer &optional _triggered-p _reuse-cell)
+  "Install TIMER."
+  (timer--check timer)
+  (cl-pushnew timer timer-list))
+
+(defsubst timer-activate-when-idle (timer &optional _dont-wait _reuse-cell)
+  "Install idle TIMER"
+  (setf (timer--idle-delay timer) 'idle)
+  (timer--check timer)
+  (cl-pushnew timer timer-idle-list))

 (defalias 'disable-timeout #'cancel-timer)

 (defun cancel-timer (timer)
   "Remove TIMER from the list of active timers."
-  (timer--check timer)
   (setq timer-list (delq timer timer-list))
   (setq timer-idle-list (delq timer timer-idle-list))
   nil)

-(defun cancel-timer-internal (timer)
-  "Remove TIMER from the list of active timers or idle timers.
-Only to be used in this file.  It returns the cons cell
-that was removed from the timer list."
-  (let ((cell1 (memq timer timer-list))
-	(cell2 (memq timer timer-idle-list)))
-    (if cell1
-	(setq timer-list (delq timer timer-list)))
-    (if cell2
-	(setq timer-idle-list (delq timer timer-idle-list)))
-    (or cell1 cell2)))
-
 (defun cancel-function-timers (function)
   "Cancel all timers which would run FUNCTION.
 This affects ordinary timers such as are scheduled by `run-at-time',
@@ -258,7 +187,7 @@ cancel-function-timers
   (dolist (timer timer-idle-list)
     (if (eq (timer--function timer) function)
         (setq timer-idle-list (delq timer timer-idle-list)))))
-
+
 ;; Record the last few events, for debugging.
 (defvar timer-event-last nil
   "Last timer that was run.")
@@ -285,74 +214,51 @@ timer-until
 (defun timer-event-handler (timer)
   "Call the handler for the timer TIMER.
 This function is called, by name, directly by the C code."
-  (setq timer-event-last-2 timer-event-last-1)
-  (setq timer-event-last-1 timer-event-last)
-  (setq timer-event-last timer)
-  (let ((inhibit-quit t))
-    (timer--check timer)
-    (let ((retrigger nil)
-          (cell
-           ;; Delete from queue.  Record the cons cell that was used.
-           (cancel-timer-internal timer)))
-      ;; If `cell' is nil, it means the timer was already canceled, so we
-      ;; shouldn't be running it at all.  This can happen for example with the
-      ;; following scenario (bug#17392):
-      ;; - we run timers, starting with A (and remembering the rest as (B C)).
-      ;; - A runs and a does a sit-for.
-      ;; - during sit-for we run timer D which cancels timer B.
-      ;; - timer A finally finishes, so we move on to timers B and C.
-      (when cell
-        ;; Re-schedule if requested.
-        (if (timer--repeat-delay timer)
-            (if (timer--idle-delay timer)
-                (timer-activate-when-idle timer nil cell)
-              (timer-inc-time timer (timer--repeat-delay timer) 0)
-              ;; If real time has jumped forward,
-              ;; perhaps because Emacs was suspended for a long time,
-              ;; limit how many times things get repeated.
-              (if (and (numberp timer-max-repeats)
-		       (time-less-p (timer--time timer) nil))
-                  (let ((repeats (/ (timer-until timer nil)
-                                    (timer--repeat-delay timer))))
-                    (if (> repeats timer-max-repeats)
-                        (timer-inc-time timer (* (timer--repeat-delay timer)
-                                                 repeats)))))
-              ;; If we want integral multiples, we have to recompute
-              ;; the repetition.
-              (when (and (> (length timer) 9) ; Backwards compatible.
-                         (timer--integral-multiple timer)
-                         (not (timer--idle-delay timer)))
-                (setf (timer--time timer)
-                      (timer-next-integral-multiple-of-time
-		       nil (timer--repeat-delay timer))))
-              ;; Place it back on the timer-list before running
-              ;; timer--function, so it can cancel-timer itself.
-              (timer-activate timer t cell)
-              (setq retrigger t)))
-        ;; Run handler.
-        (condition-case-unless-debug err
-            ;; Timer functions should not change the current buffer.
-            ;; If they do, all kinds of nasty surprises can happen,
-            ;; and it can be hellish to track down their source.
-            (save-current-buffer
-              (apply (timer--function timer) (timer--args timer)))
-          (error (message "Error running timer%s: %S"
-                          (if (symbolp (timer--function timer))
-                              (format-message " `%s'" (timer--function timer))
-                            "")
-                          err)))
-        (when (and retrigger
-                   ;; If the timer's been canceled, don't "retrigger" it
-                   ;; since it might still be in the copy of timer-list kept
-                   ;; by keyboard.c:timer_check (bug#14156).
-                   (memq timer timer-list))
-          (setf (timer--triggered timer) nil))))))
+  (setq timer-event-last-2 timer-event-last-1
+        timer-event-last-1 timer-event-last
+        timer-event-last timer)
+  (let ((inhibit-quit t)
+        (run-handler
+         (lambda (timer)
+           (condition-case-unless-debug err
+               (save-current-buffer
+                 (setf (timer--triggered timer) t)
+                 (let ((restore-deactivate-mark deactivate-mark))
+                   (apply (timer--function timer) (timer--args timer))
+                   (setq deactivate-mark restore-deactivate-mark)))
+             (error (message "Error running timer%s: %s"
+                             (if (symbolp (timer--function timer))
+                                 (format-message " '%s'" (timer--function timer))
+                               "")
+                             (error-message-string err)))))))
+    (cond ((memq timer timer-list)
+           (funcall run-handler timer)
+           (if (not (timer--repeat-delay timer))
+               ;; dequeue
+               (cancel-timer timer)
+             ;; requeue at new time
+             (setf (timer--triggered timer) nil)
+             (if (timer--integral-multiple timer)
+                 (setf (timer--time timer)
+                       (timer-next-integral-multiple-of-time
+		        nil (timer--repeat-delay timer)))
+               (timer-inc-time timer (timer--repeat-delay timer)))
+             (when (numberp timer-max-repeats)
+               ;; Limit repetitions in case emacs was unduly suspended
+               (let ((limit (time-subtract nil (* timer-max-repeats
+                                                  (timer--repeat-delay timer)))))
+                 (when (time-less-p (timer--time timer) limit)
+                   (setf (timer--time timer) limit))))))
+          ((memq timer timer-idle-list)
+           (funcall run-handler timer)
+           (unless (timer--repeat-delay timer)
+             (cancel-timer timer))))))

 ;; This function is incompatible with the one in levents.el.
 (defun timeout-event-p (event)
   "Non-nil if EVENT is a timeout event."
   (and (listp event) (eq (car event) 'timer-event)))
-
+

 (declare-function diary-entry-time "diary-lib" (s))

@@ -451,19 +357,11 @@ add-timeout
   (run-with-timer secs repeat function object))

 (defun run-with-idle-timer (secs repeat function &rest args)
-  "Perform an action the next time Emacs is idle for SECS seconds.
-The action is to call FUNCTION with arguments ARGS.
-SECS may be an integer, a floating point number, or the internal
-time format returned by, e.g., `current-idle-time'.
-If Emacs is currently idle, and has been idle for N seconds (N < SECS),
-then it will call FUNCTION in SECS - N seconds from now.  Using
-SECS <= N is not recommended if this function is invoked from an idle
-timer, because FUNCTION will then be called immediately.
-
-If REPEAT is non-nil, do the action each time Emacs has been idle for
-exactly SECS seconds (that is, only once for each time Emacs becomes idle).
-
-This function returns a timer object which you can use in `cancel-timer'."
+  "Call FUNCTION on ARGS when idle for SECS seconds.
+If REPEAT is non-nil, repeat the behavior until cancelled via
+`cancel-timer'.  SECS may be an integer, a floating point number,
+or the internal time format returned by, e.g.,
+`current-idle-time'."
   (interactive
    (list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
 	 (y-or-n-p "Repeat each time Emacs is idle? ")
@@ -471,9 +369,9 @@ run-with-idle-timer
   (let ((timer (timer-create)))
     (timer-set-function timer function args)
     (timer-set-idle-time timer secs repeat)
-    (timer-activate-when-idle timer t)
+    (timer-activate-when-idle timer)
     timer))
-
+
 (defvar with-timeout-timers nil
   "List of all timers used by currently pending `with-timeout' calls.")

@@ -533,7 +431,7 @@ y-or-n-p-with-timeout
 If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
   (with-timeout (seconds default-value)
     (y-or-n-p prompt)))
-
+
 (defconst timer-duration-words
   (list (cons "microsec" 0.000001)
 	(cons "microsecond" 0.000001)
@@ -578,9 +476,8 @@ timer-duration
 (defun internal-timer-start-idle ()
   "Mark all idle-time timers as once again candidates for running."
   (dolist (timer timer-idle-list)
-    (if (timerp timer) ;; FIXME: Why test?
-        (setf (timer--triggered timer) nil))))
-
+    (setf (timer--triggered timer) nil)))
+
 (provide 'timer)

 ;;; timer.el ends here
diff --git a/lisp/frame.el b/lisp/frame.el
index b820d5fcd96..6eb7459ba42 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2861,7 +2861,7 @@ blink-cursor--start-idle-timer
         ;; during command execution) if they set blink-cursor-delay
         ;; to a very small or even zero value.
         (run-with-idle-timer (max 0.2 blink-cursor-delay)
-                             :repeat #'blink-cursor-start)))
+                             t #'blink-cursor-start)))

 (defun blink-cursor--start-timer ()
   "Start the `blink-cursor-timer'."
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 452cbd1ca51..2246cff28bf 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -593,7 +593,7 @@ jit-lock-stealth-fontify
       (when jit-lock-stealth-buffers
 	(timer-set-idle-time jit-lock-stealth-repeat-timer (current-idle-time))
 	(timer-inc-time jit-lock-stealth-repeat-timer delay)
-	(timer-activate-when-idle jit-lock-stealth-repeat-timer t)))))
+        (timer-activate-when-idle jit-lock-stealth-repeat-timer)))))

 
 ;;; Deferred fontification.
diff --git a/lisp/time.el b/lisp/time.el
index 522bec46ac6..280293a9de2 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -238,8 +238,8 @@ display-time-event-handler
 	 (timer display-time-timer)
 	 ;; Compute the time when this timer will run again, next.
 	 (next-time (timer-relative-time
-		     (list (aref timer 1) (aref timer 2) (aref timer 3))
-		     (* 5 (aref timer 4)) 0)))
+                     (timer--time timer)
+		     (* 5 (timer--repeat-delay timer)) 0)))
     ;; If the activation time is not in the future,
     ;; skip executions until we reach a time in the future.
     ;; This avoids a long pause if Emacs has been suspended for hours.
diff --git a/src/fns.c b/src/fns.c
index 0af9b725c7a..28cffc9053f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -751,7 +751,7 @@ DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
       Lisp_Object val = Fcons (XCAR (arg), Qnil);
       Lisp_Object prev = val;
       Lisp_Object tail = XCDR (arg);
-      FOR_EACH_TAIL (tail)
+      FOR_EACH_TAIL_SAFE (tail)
 	{
 	  Lisp_Object c = Fcons (XCAR (tail), Qnil);
 	  XSETCDR (prev, c);
diff --git a/src/keyboard.c b/src/keyboard.c
index b2816f8270b..761e731fb22 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -4527,47 +4527,9 @@ timer_resume_idle (void)
    ...).  Each element has the form (FUN . ARGS).  */
 Lisp_Object pending_funcalls;

-/* Return true if TIMER is a valid timer, placing its value into *RESULT.  */
-static bool
-decode_timer (Lisp_Object timer, struct timespec *result)
-{
-  Lisp_Object *vec;
-
-  if (! (VECTORP (timer) && ASIZE (timer) == 10))
-    return false;
-  vec = XVECTOR (timer)->contents;
-  if (! NILP (vec[0]))
-    return false;
-  if (! FIXNUMP (vec[2]))
-    return false;
-  return list4_to_timespec (vec[1], vec[2], vec[3], vec[8], result);
-}
-
-
-/* Check whether a timer has fired.  To prevent larger problems we simply
-   disregard elements that are not proper timers.  Do not make a circular
-   timer list for the time being.
-
-   Returns the time to wait until the next timer fires.  If a
-   timer is triggering now, return zero.
-   If no timer is active, return -1.
-
-   If a timer is ripe, we run it, with quitting turned off.
-   In that case we return 0 to indicate that a new timer_check_2 call
-   should be done.  */
-
-static struct timespec
-timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
+static void
+trigger_timer (Lisp_Object timer)
 {
-  struct timespec nexttime;
-  struct timespec now;
-  struct timespec idleness_now;
-  Lisp_Object chosen_timer;
-
-  nexttime = invalid_timespec ();
-
-  chosen_timer = Qnil;
-
   /* First run the code that was delayed.  */
   while (CONSP (pending_funcalls))
     {
@@ -4575,180 +4537,77 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
       pending_funcalls = XCDR (pending_funcalls);
       safe_call2 (Qapply, XCAR (funcall), XCDR (funcall));
     }
-
-  if (CONSP (timers) || CONSP (idle_timers))
-    {
-      now = current_timespec ();
-      idleness_now = (timespec_valid_p (timer_idleness_start_time)
-		      ? timespec_sub (now, timer_idleness_start_time)
-		      : make_timespec (0, 0));
-    }
-
-  while (CONSP (timers) || CONSP (idle_timers))
-    {
-      Lisp_Object timer = Qnil, idle_timer = Qnil;
-      struct timespec timer_time, idle_timer_time;
-      struct timespec difference;
-      struct timespec timer_difference = invalid_timespec ();
-      struct timespec idle_timer_difference = invalid_timespec ();
-      bool ripe, timer_ripe = 0, idle_timer_ripe = 0;
-
-      /* Set TIMER and TIMER_DIFFERENCE
-	 based on the next ordinary timer.
-	 TIMER_DIFFERENCE is the distance in time from NOW to when
-	 this timer becomes ripe.
-         Skip past invalid timers and timers already handled.  */
-      if (CONSP (timers))
-	{
-	  timer = XCAR (timers);
-	  if (! decode_timer (timer, &timer_time))
-	    {
-	      timers = XCDR (timers);
-	      continue;
-	    }
-
-	  timer_ripe = timespec_cmp (timer_time, now) <= 0;
-	  timer_difference = (timer_ripe
-			      ? timespec_sub (now, timer_time)
-			      : timespec_sub (timer_time, now));
-	}
-
-      /* Likewise for IDLE_TIMER and IDLE_TIMER_DIFFERENCE
-	 based on the next idle timer.  */
-      if (CONSP (idle_timers))
-	{
-	  idle_timer = XCAR (idle_timers);
-	  if (! decode_timer (idle_timer, &idle_timer_time))
-	    {
-	      idle_timers = XCDR (idle_timers);
-	      continue;
-	    }
-
-	  idle_timer_ripe = timespec_cmp (idle_timer_time, idleness_now) <= 0;
-	  idle_timer_difference
-	    = (idle_timer_ripe
-	       ? timespec_sub (idleness_now, idle_timer_time)
-	       : timespec_sub (idle_timer_time, idleness_now));
-	}
-
-      /* Decide which timer is the next timer,
-	 and set CHOSEN_TIMER, DIFFERENCE, and RIPE accordingly.
-	 Also step down the list where we found that timer.  */
-
-      if (timespec_valid_p (timer_difference)
-	  && (! timespec_valid_p (idle_timer_difference)
-	      || idle_timer_ripe < timer_ripe
-	      || (idle_timer_ripe == timer_ripe
-		  && ((timer_ripe
-		       ? timespec_cmp (idle_timer_difference,
-				       timer_difference)
-		       : timespec_cmp (timer_difference,
-				       idle_timer_difference))
-		      < 0))))
-	{
-	  chosen_timer = timer;
-	  timers = XCDR (timers);
-	  difference = timer_difference;
-	  ripe = timer_ripe;
-	}
-      else
-	{
-	  chosen_timer = idle_timer;
-	  idle_timers = XCDR (idle_timers);
-	  difference = idle_timer_difference;
-	  ripe = idle_timer_ripe;
-	}
-
-      /* If timer is ripe, run it if it hasn't been run.  */
-      if (ripe)
-	{
-	  /* If we got here, presumably `decode_timer` has checked
-             that this timer has not yet been triggered.  */
-	  eassert (NILP (AREF (chosen_timer, 0)));
-	  /* In a production build, where assertions compile to
-	     nothing, we still want to play it safe here.  */
-	  if (NILP (AREF (chosen_timer, 0)))
-	    {
-	      specpdl_ref count = SPECPDL_INDEX ();
-	      Lisp_Object old_deactivate_mark = Vdeactivate_mark;
-
-	      /* Mark the timer as triggered to prevent problems if the lisp
-		 code fails to reschedule it right.  */
-	      ASET (chosen_timer, 0, Qt);
-
-	      specbind (Qinhibit_quit, Qt);
-
-	      call1 (Qtimer_event_handler, chosen_timer);
-	      Vdeactivate_mark = old_deactivate_mark;
-	      timers_run++;
-	      unbind_to (count, Qnil);
-
-	      /* Since we have handled the event,
-		 we don't need to tell the caller to wake up and do it.  */
-	      /* But the caller must still wait for the next timer, so
-		 return 0 to indicate that.  */
-	    }
-
-	  nexttime = make_timespec (0, 0);
-          break;
-	}
-      else
-	/* When we encounter a timer that is still waiting,
-	   return the amount of time to wait before it is ripe.  */
-	{
-	  return difference;
-	}
-    }
-
-  /* No timers are pending in the future.  */
-  /* Return 0 if we generated an event, and -1 if not.  */
-  return nexttime;
+  call1 (Qtimer_event_handler, timer);
+  timers_run++;
 }

+/* Trigger any timers meeting their respective criteria.

-/* Check whether a timer has fired.  To prevent larger problems we simply
-   disregard elements that are not proper timers.  Do not make a circular
-   timer list for the time being.
+   For ordinary timers, this means current time is at
+   or past their scheduled time.

-   Returns the time to wait until the next timer fires.
-   If no timer is active, return an invalid value.
+   For idle timers, this means the idled period exceeds
+   their idle threshold.

-   As long as any timer is ripe, we run it.  */
+   Return the time distance to the next upcoming timer.
+*/

 struct timespec
 timer_check (void)
 {
-  struct timespec nexttime;
-  Lisp_Object timers, idle_timers;
-
-  Lisp_Object tem = Vinhibit_quit;
-  Vinhibit_quit = Qt;
-  block_input ();
-  turn_on_atimers (false);
-
-  /* We use copies of the timers' lists to allow a timer to add itself
-     again, without locking up Emacs if the newly added timer is
-     already ripe when added.  */
+  struct timespec now = current_timespec ();
+  struct timespec idled = timespec_valid_p (timer_idleness_start_time)
+    ? timespec_sub (now, timer_idleness_start_time)
+    : invalid_timespec ();
+  struct timespec until_next = invalid_timespec ();
+  Lisp_Object *const lists[] = { &Vtimer_list, &Vtimer_idle_list };
+  struct timespec const bogeys[] = { now, idled };

-  /* Always consider the ordinary timers.  */
-  timers = Fcopy_sequence (Vtimer_list);
-  /* Consider the idle timers only if Emacs is idle.  */
-  if (timespec_valid_p (timer_idleness_start_time))
-    idle_timers = Fcopy_sequence (Vtimer_idle_list);
-  else
-    idle_timers = Qnil;
-
-  turn_on_atimers (true);
-  unblock_input ();
-  Vinhibit_quit = tem;
-
-  do
+  for (int i = 0; i < 2; ++i)
     {
-      nexttime = timer_check_2 (timers, idle_timers);
+      struct timespec bogey = bogeys[i];
+      if (! timespec_valid_p (bogey))
+	continue;
+
+      Lisp_Object timers = Fcopy_sequence (*lists[i]);
+      FOR_EACH_TAIL_SAFE (timers)
+	{
+	  struct timespec time;
+	  Lisp_Object *vec;
+	  CHECK_VECTOR (XCAR (timers));
+	  vec = XVECTOR (XCAR (timers))->contents;
+	  if (NILP (vec[0])) /* not yet triggered */
+	    {
+	      if (list4_to_timespec (vec[1], vec[2], vec[3], vec[8], &time))
+		{
+		  /* Trigger when:
+		     For ordinary timer, now is at or past trigger time.
+		     For idle timer, idled duration at or past threshold.  */
+		  if (timespec_cmp (bogey, time) >= 0)
+		    {
+		      trigger_timer (XCAR (timers));
+		    }
+		  else
+		    {
+		      struct timespec diff = timespec_sub (time, bogey);
+		      if (! timespec_valid_p (until_next)
+			  || timespectod (diff) < timespectod (until_next))
+			until_next = diff;
+		    }
+		}
+	    }
+	  else /* was triggered */
+	    {
+	      /* Clean up timers that errored out.  */
+	      if (NILP (vec[4])) /* if not repeated, delete it.  */
+		*lists[i] = Fdelq (XCAR (timers), *lists[i]);
+	      else if (NILP (vec[7]) /* if not idle, reset it. */)
+		vec[0] = Qnil;
+	    }
+	}
     }
-  while (nexttime.tv_sec == 0 && nexttime.tv_nsec == 0);

-  return nexttime;
+  return until_next;
 }

 DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el
index 7652b324493..be59727620d 100644
--- a/test/lisp/emacs-lisp/timer-tests.el
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -65,4 +65,30 @@ timer-next-integral-multiple-of-time-3
   (let ((nt (timer-next-integral-multiple-of-time '(32770 . 65539) 0.5)))
     (should (time-equal-p 1 nt))))

+(defvar timer-test-debug-on-error-delay 0.5)
+(defvar timer-test-debug-on-error-timer nil)
+
+(ert-deftest timer-test-debug-on-error-0 ()
+  "Set the trap."
+  :expected-result :failed
+  (setq timer-test-debug-on-error-timer
+        (run-at-time nil timer-test-debug-on-error-delay
+                     (lambda ()
+                       (setf (timer--function timer-test-debug-on-error-timer)
+                             #'ignore)
+                       (error "foo"))))
+  (sit-for 0.1 t))
+
+(ert-deftest timer-test-debug-on-error-1 ()
+  "Recover when `debug-on-error' leaves timer-event-handler in limbo."
+  (should debug-on-error)
+  (unwind-protect
+      (progn
+        (sit-for (* timer-test-debug-on-error-delay 3) t)
+        (should-not (timer--triggered timer-test-debug-on-error-timer))
+        (list-timers)
+        (with-current-buffer "*timer-list*"
+          (should-error (re-search-forward (regexp-quote "-1d ")))))
+    (cancel-timer timer-test-debug-on-error-timer)))
+
 ;;; timer-tests.el ends here
--
2.38.1




Reply sent to Po Lu <luangruo <at> yahoo.com>:
You have taken responsibility. (Fri, 24 Feb 2023 00:56:01 GMT) Full text and rfc822 format available.

Notification sent to dick.r.chiang <at> gmail.com:
bug acknowledged by developer. (Fri, 24 Feb 2023 00:56:02 GMT) Full text and rfc822 format available.

Message #10 received at 61741-done <at> debbugs.gnu.org (full text, mbox):

From: Po Lu <luangruo <at> yahoo.com>
To: dick.r.chiang <at> gmail.com
Cc: 61741-done <at> debbugs.gnu.org
Subject: Re: bug#61741: 30.0.50; [PATCH] Reset errant timers
Date: Fri, 24 Feb 2023 08:55:28 +0800
dick.r.chiang <at> gmail.com writes:

> +(defsubst timer-activate (timer &optional _triggered-p _reuse-cell)
> +  "Install TIMER."
> +  (timer--check timer)
> +  (cl-pushnew timer timer-list))
> +
> +(defsubst timer-activate-when-idle (timer &optional _dont-wait _reuse-cell)
> +  "Install idle TIMER"
> +  (setf (timer--idle-delay timer) 'idle)
> +  (timer--check timer)
> +  (cl-pushnew timer timer-idle-list))
>
>  (defalias 'disable-timeout #'cancel-timer)
>
>  (defun cancel-timer (timer)
>    "Remove TIMER from the list of active timers."
> -  (timer--check timer)
>    (setq timer-list (delq timer timer-list))
>    (setq timer-idle-list (delq timer timer-idle-list))
>    nil)
>

The more doc strings and comments you delete, the less likely it is for
anyone to install your change.  Quit wasting others' time!

>  (defun run-with-idle-timer (secs repeat function &rest args)
> -  "Perform an action the next time Emacs is idle for SECS seconds.
> -The action is to call FUNCTION with arguments ARGS.
> -SECS may be an integer, a floating point number, or the internal
> -time format returned by, e.g., `current-idle-time'.
> -If Emacs is currently idle, and has been idle for N seconds (N < SECS),
> -then it will call FUNCTION in SECS - N seconds from now.  Using
> -SECS <= N is not recommended if this function is invoked from an idle
> -timer, because FUNCTION will then be called immediately.
> -
> -If REPEAT is non-nil, do the action each time Emacs has been idle for
> -exactly SECS seconds (that is, only once for each time Emacs becomes idle).
> -
> -This function returns a timer object which you can use in `cancel-timer'."
> +  "Call FUNCTION on ARGS when idle for SECS seconds.
> +If REPEAT is non-nil, repeat the behavior until cancelled via
> +`cancel-timer'.  SECS may be an integer, a floating point number,
> +or the internal time format returned by, e.g.,
> +`current-idle-time'."

Here too.  You also deleted the part of the doc string that explains
what to give to cancel-timer.

> -
> +
>  (defvar with-timeout-timers nil
>    "List of all timers used by currently pending `with-timeout' calls.")
>
> @@ -533,7 +431,7 @@ y-or-n-p-with-timeout
>  If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
>    (with-timeout (seconds default-value)
>      (y-or-n-p prompt)))
> -
> +

Stop removing page breaks.


> -      FOR_EACH_TAIL (tail)
> +      FOR_EACH_TAIL_SAFE (tail)
>  	{

...because?  Now you will no longer be able to quit from Fcopy_sequence,
and instead of a lock up upon encountering a circular list, you get the
list with random contents appended at the end.

> +/* Trigger any timers meeting their respective criteria.
>
> -/* Check whether a timer has fired.  To prevent larger problems we simply
> -   disregard elements that are not proper timers.  Do not make a circular
> -   timer list for the time being.
> +   For ordinary timers, this means current time is at
> +   or past their scheduled time.
>
> -   Returns the time to wait until the next timer fires.
> -   If no timer is active, return an invalid value.
> +   For idle timers, this means the idled period exceeds
> +   their idle threshold.
>
> -   As long as any timer is ripe, we run it.  */
> +   Return the time distance to the next upcoming timer.
> +*/
>
>  struct timespec
>  timer_check (void)
>  {
> -  struct timespec nexttime;
> -  Lisp_Object timers, idle_timers;
> -
> -  Lisp_Object tem = Vinhibit_quit;
> -  Vinhibit_quit = Qt;
> -  block_input ();
> -  turn_on_atimers (false);
> -
> -  /* We use copies of the timers' lists to allow a timer to add itself
> -     again, without locking up Emacs if the newly added timer is
> -     already ripe when added.  */
> +  struct timespec now = current_timespec ();
> +  struct timespec idled = timespec_valid_p (timer_idleness_start_time)
> +    ? timespec_sub (now, timer_idleness_start_time)
> +    : invalid_timespec ();
> +  struct timespec until_next = invalid_timespec ();
> +  Lisp_Object *const lists[] = { &Vtimer_list, &Vtimer_idle_list };
> +  struct timespec const bogeys[] = { now, idled };
>
> -  /* Always consider the ordinary timers.  */
> -  timers = Fcopy_sequence (Vtimer_list);
> -  /* Consider the idle timers only if Emacs is idle.  */
> -  if (timespec_valid_p (timer_idleness_start_time))
> -    idle_timers = Fcopy_sequence (Vtimer_idle_list);
> -  else
> -    idle_timers = Qnil;
> -
> -  turn_on_atimers (true);
> -  unblock_input ();
> -  Vinhibit_quit = tem;
> -
> -  do
> +  for (int i = 0; i < 2; ++i)
>      {
> -      nexttime = timer_check_2 (timers, idle_timers);
> +      struct timespec bogey = bogeys[i];
> +      if (! timespec_valid_p (bogey))
> +	continue;
> +
> +      Lisp_Object timers = Fcopy_sequence (*lists[i]);
> +      FOR_EACH_TAIL_SAFE (timers)
> +	{
> +	  struct timespec time;
> +	  Lisp_Object *vec;
> +	  CHECK_VECTOR (XCAR (timers));
> +	  vec = XVECTOR (XCAR (timers))->contents;
> +	  if (NILP (vec[0])) /* not yet triggered */
> +	    {
> +	      if (list4_to_timespec (vec[1], vec[2], vec[3], vec[8], &time))
> +		{
> +		  /* Trigger when:
> +		     For ordinary timer, now is at or past trigger time.
> +		     For idle timer, idled duration at or past threshold.  */
> +		  if (timespec_cmp (bogey, time) >= 0)
> +		    {
> +		      trigger_timer (XCAR (timers));
> +		    }
> +		  else
> +		    {
> +		      struct timespec diff = timespec_sub (time, bogey);
> +		      if (! timespec_valid_p (until_next)
> +			  || timespectod (diff) < timespectod (until_next))
> +			until_next = diff;
> +		    }
> +		}
> +	    }
> +	  else /* was triggered */
> +	    {
> +	      /* Clean up timers that errored out.  */
> +	      if (NILP (vec[4])) /* if not repeated, delete it.  */
> +		*lists[i] = Fdelq (XCAR (timers), *lists[i]);
> +	      else if (NILP (vec[7]) /* if not idle, reset it. */)
> +		vec[0] = Qnil;
> +	    }
> +	}
>      }
> -  while (nexttime.tv_sec == 0 && nexttime.tv_nsec == 0);
>
> -  return nexttime;
> +  return until_next;
>  }

If you cannot quit your habit of making irrelevant changes that go
unexplained and reduce the total volume of the commentary, do not expect
anything you write to be installed.

Please file a bug for whatever you think is the problem instead.




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Fri, 24 Mar 2023 11:24:09 GMT) Full text and rfc822 format available.

This bug report was last modified 1 year and 26 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.