diff options
| -rw-r--r-- | modules/calendar-sync-source.el | 15 | ||||
| -rw-r--r-- | modules/calendar-sync.el | 18 | ||||
| -rw-r--r-- | tests/test-calendar-sync--syncing-p.el | 84 |
3 files changed, 112 insertions, 5 deletions
diff --git a/modules/calendar-sync-source.el b/modules/calendar-sync-source.el index d9efc885b..15c91c594 100644 --- a/modules/calendar-sync-source.el +++ b/modules/calendar-sync-source.el @@ -90,7 +90,13 @@ Hash table mapping calendar name (string) to state plist with: (let ((cal-states (alist-get 'calendar-states state))) (clrhash calendar-sync--calendar-states) (dolist (entry cal-states) - (puthash (car entry) (cdr entry) calendar-sync--calendar-states))))) + (let ((st (cdr entry))) + ;; A persisted `syncing' status is stale in a fresh process + ;; (no sync is actually running), so reset it; otherwise the + ;; in-flight guard would skip that calendar forever. + (when (eq (plist-get st :status) 'syncing) + (setq st (plist-put (copy-sequence st) :status 'never))) + (puthash (car entry) st calendar-sync--calendar-states)))))) (error (calendar-sync--log-silently "calendar-sync: Error loading state: %s" (error-message-string err)))))) @@ -98,6 +104,13 @@ Hash table mapping calendar name (string) to state plist with: "Get state plist for CALENDAR-NAME, or nil if not found." (gethash calendar-name calendar-sync--calendar-states)) +(defun calendar-sync--syncing-p (calendar-name) + "Return non-nil when CALENDAR-NAME has an in-flight sync. +Used to skip an overlapping sync when a timer tick fires while the previous +sync for the same calendar is still running." + (eq (plist-get (calendar-sync--get-calendar-state calendar-name) :status) + 'syncing)) + (defun calendar-sync--set-calendar-state (calendar-name state) "Set STATE plist for CALENDAR-NAME." (puthash calendar-name state calendar-sync--calendar-states)) diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index 297d1fe61..804d71faf 100644 --- a/modules/calendar-sync.el +++ b/modules/calendar-sync.el @@ -211,10 +211,20 @@ fetcher) or :account + :calendar-id (the \\='api fetcher). Dispatches on the :fetcher key, defaulting to the .ics path. Updates calendar state and saves to disk on completion. The fetch and conversion run in external processes so parsing and writing large -calendar files do not block the interactive Emacs thread." - (if (eq (plist-get calendar :fetcher) 'api) - (calendar-sync--sync-calendar-api calendar) - (calendar-sync--sync-calendar-ics calendar))) +calendar files do not block the interactive Emacs thread. + +Skips a calendar whose previous sync is still in flight, so a timer tick that +fires before a slow fetch finishes does not launch a second overlapping sync for +the same calendar." + (let ((name (plist-get calendar :name))) + (cond + ((calendar-sync--syncing-p name) + (calendar-sync--log-silently + "calendar-sync: [%s] sync already in flight; skipping overlapping tick" name)) + ((eq (plist-get calendar :fetcher) 'api) + (calendar-sync--sync-calendar-api calendar)) + (t + (calendar-sync--sync-calendar-ics calendar))))) (defun calendar-sync--require-calendars () "Return non-nil if calendars are configured, else warn and return nil." diff --git a/tests/test-calendar-sync--syncing-p.el b/tests/test-calendar-sync--syncing-p.el new file mode 100644 index 000000000..b346bf776 --- /dev/null +++ b/tests/test-calendar-sync--syncing-p.el @@ -0,0 +1,84 @@ +;;; test-calendar-sync--syncing-p.el --- Tests for the in-flight sync guard -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for `calendar-sync--syncing-p' (the per-calendar in-flight check +;; that lets the dispatcher skip an overlapping timer tick) and for the +;; load-state sanitize that clears a stale `syncing' status in a fresh process. + +;;; Code: + +(require 'ert) +(require 'calendar-sync) + +(defun test-cs-syncing--reset () + "Clear the module's per-calendar state hash." + (clrhash calendar-sync--calendar-states)) + +;;; calendar-sync--syncing-p + +(ert-deftest test-calendar-sync--syncing-p-normal-true-when-syncing () + "Normal: a calendar whose status is `syncing' reads as in-flight." + (test-cs-syncing--reset) + (calendar-sync--set-calendar-state "google" '(:status syncing)) + (should (calendar-sync--syncing-p "google"))) + +(ert-deftest test-calendar-sync--syncing-p-boundary-nil-when-no-state () + "Boundary: a calendar with no recorded state is not in-flight." + (test-cs-syncing--reset) + (should-not (calendar-sync--syncing-p "never-seen"))) + +(ert-deftest test-calendar-sync--syncing-p-error-nil-for-terminal-status () + "Error: a terminal status (ok / error) is not in-flight." + (test-cs-syncing--reset) + (calendar-sync--set-calendar-state "google" '(:status ok)) + (should-not (calendar-sync--syncing-p "google")) + (calendar-sync--set-calendar-state "proton" '(:status error)) + (should-not (calendar-sync--syncing-p "proton"))) + +;;; Dispatcher guard: an in-flight calendar skips both leaf syncers + +(ert-deftest test-calendar-sync--sync-calendar-skips-when-in-flight () + "Normal: `calendar-sync--sync-calendar' does not launch a second sync for a +calendar already marked syncing, so an overlapping timer tick is a no-op." + (test-cs-syncing--reset) + (let ((api-calls '()) (ics-calls '())) + (cl-letf (((symbol-function 'calendar-sync--sync-calendar-api) + (lambda (cal) (push cal api-calls))) + ((symbol-function 'calendar-sync--sync-calendar-ics) + (lambda (cal) (push cal ics-calls)))) + (calendar-sync--set-calendar-state "proton" '(:status syncing)) + (calendar-sync--sync-calendar '(:name "proton" :url "https://x/y.ics" + :file "/tmp/c.org")) + (should (null api-calls)) + (should (null ics-calls))))) + +(ert-deftest test-calendar-sync--sync-calendar-dispatches-when-idle () + "Boundary: an idle calendar (no in-flight status) still dispatches normally." + (test-cs-syncing--reset) + (let ((ics-calls '())) + (cl-letf (((symbol-function 'calendar-sync--sync-calendar-ics) + (lambda (cal) (push cal ics-calls)))) + (calendar-sync--sync-calendar '(:name "proton" :url "https://x/y.ics" + :file "/tmp/c.org")) + (should (= 1 (length ics-calls)))))) + +;;; load-state sanitize: a persisted `syncing' status is cleared on load + +(ert-deftest test-calendar-sync--load-state-clears-stale-syncing () + "Error: a `syncing' status persisted before a crash is reset on load, so the +in-flight guard cannot skip that calendar forever in the new session." + (test-cs-syncing--reset) + (let* ((dir (make-temp-file "cs-state-" t)) + (calendar-sync--state-file (expand-file-name "state.el" dir))) + (unwind-protect + (progn + (with-temp-file calendar-sync--state-file + (prin1 '((timezone-offset . nil) + (calendar-states . (("google" . (:status syncing))))) + (current-buffer))) + (calendar-sync--load-state) + (should-not (calendar-sync--syncing-p "google"))) + (delete-directory dir t)))) + +(provide 'test-calendar-sync--syncing-p) +;;; test-calendar-sync--syncing-p.el ends here |