diff options
| -rw-r--r-- | modules/calendar-sync-ics.el | 12 | ||||
| -rw-r--r-- | modules/calendar-sync-recurrence.el | 10 | ||||
| -rw-r--r-- | tests/test-calendar-sync--expand-daily.el | 47 | ||||
| -rw-r--r-- | tests/test-calendar-sync--expand-weekly.el | 28 | ||||
| -rw-r--r-- | tests/test-calendar-sync-properties.el | 40 |
5 files changed, 127 insertions, 10 deletions
diff --git a/modules/calendar-sync-ics.el b/modules/calendar-sync-ics.el index 9cb57e96..4888112c 100644 --- a/modules/calendar-sync-ics.el +++ b/modules/calendar-sync-ics.el @@ -218,6 +218,18 @@ Both dates should be lists like (year month day)." (time-less-p (calendar-sync--date-to-time date1) (calendar-sync--date-to-time date2))) +(defun calendar-sync--date-on-or-before-p (date1 date2) + "Return t if DATE1 falls on or before DATE2. +Both dates should be lists like (year month day); like +`calendar-sync--date-to-time', only the first three elements are compared, +so any hour/minute tail is ignored. + +This is the comparison RRULE UNTIL needs. RFC 5545 3.3.10 bounds a +recurrence \"in an inclusive manner\": when UNTIL lines up with the +recurrence, that date is the last instance. A strict +`calendar-sync--before-date-p' drops it." + (not (calendar-sync--before-date-p date2 date1))) + ;;; Datetime Parsing (defun calendar-sync--parse-ics-datetime (value) diff --git a/modules/calendar-sync-recurrence.el b/modules/calendar-sync-recurrence.el index 2689cdd6..1cb25636 100644 --- a/modules/calendar-sync-recurrence.el +++ b/modules/calendar-sync-recurrence.el @@ -322,7 +322,8 @@ ADVANCE-FN takes (current-date interval) and returns the next date." (num-generated 0) (range-end-time (cadr range))) (while (and (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) - (or (not until) (calendar-sync--before-date-p current-date until)) + ;; UNTIL is inclusive (RFC 5545 3.3.10) -- on-or-before, not before. + (or (not until) (calendar-sync--date-on-or-before-p current-date until)) (or (not count) (< num-generated count))) (let ((occurrence-datetime (append current-date (nthcdr 3 start)))) (setq num-generated (1+ num-generated)) @@ -364,7 +365,8 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (while (and (< iterations max-iterations) (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) (or (not count) (< num-generated count)) - (or (not until) (calendar-sync--before-date-p current-date until))) + ;; UNTIL is inclusive (RFC 5545 3.3.10) -- on-or-before, not before. + (or (not until) (calendar-sync--date-on-or-before-p current-date until))) (setq iterations (1+ iterations)) ;; Generate occurrences for each weekday in this week (dolist (weekday weekdays) @@ -372,8 +374,8 @@ BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." (days-ahead (mod (- weekday current-weekday) 7)) (occurrence-date (calendar-sync--add-days current-date days-ahead)) (occurrence-datetime (append occurrence-date (nthcdr 3 start)))) - ;; Check UNTIL date first - (when (or (not until) (calendar-sync--before-date-p occurrence-date until)) + ;; Check UNTIL date first -- inclusive per RFC 5545 3.3.10. + (when (or (not until) (calendar-sync--date-on-or-before-p occurrence-date until)) ;; Check COUNT - increment BEFORE range check so COUNT is absolute from start (when (or (not count) (< num-generated count)) (setq num-generated (1+ num-generated)) diff --git a/tests/test-calendar-sync--expand-daily.el b/tests/test-calendar-sync--expand-daily.el index 43b93664..0db9f345 100644 --- a/tests/test-calendar-sync--expand-daily.el +++ b/tests/test-calendar-sync--expand-daily.el @@ -176,5 +176,52 @@ (occurrences (calendar-sync--expand-daily base-event rrule range))) (should (= (length occurrences) 5)))) +;;; UNTIL is inclusive (RFC 5545 3.3.10) + +(ert-deftest test-calendar-sync--expand-daily-until-includes-the-until-date () + "Boundary: an occurrence falling ON the UNTIL date is kept. +RFC 5545 3.3.10: UNTIL bounds the recurrence \"in an inclusive manner\", and +when it lines up with the recurrence that date \"becomes the last instance\". +A strict before-comparison drops it, so the last meeting of every bounded +series silently vanishes from the agenda." + (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) + (until-date (test-calendar-sync-time-date-only 5)) + (base-event (list :summary "Bounded Standup" :start start-date)) + (rrule (list :freq 'daily :interval 1 :until until-date)) + (range (test-calendar-sync-wide-range)) + (occurrences (calendar-sync--expand-daily base-event rrule range)) + (last-start (plist-get (car (last occurrences)) :start))) + ;; day+1 through day+5 inclusive = 5 occurrences. + (should (= (length occurrences) 5)) + ;; The final occurrence is the UNTIL date itself. + (should (equal (seq-take last-start 3) until-date)))) + +(ert-deftest test-calendar-sync--expand-daily-until-excludes-dates-after-it () + "Boundary: inclusivity stops at UNTIL; the next day is not generated. +Guards the fix against over-correcting into an off-by-one the other way." + (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) + (until-date (test-calendar-sync-time-date-only 5)) + (day-after (test-calendar-sync-time-date-only 6)) + (base-event (list :summary "Bounded Standup" :start start-date)) + (rrule (list :freq 'daily :interval 1 :until until-date)) + (range (test-calendar-sync-wide-range)) + (occurrences (calendar-sync--expand-daily base-event rrule range)) + (dates (mapcar (lambda (o) (seq-take (plist-get o :start) 3)) occurrences))) + (should (member until-date dates)) + (should-not (member day-after dates)))) + +(ert-deftest test-calendar-sync--expand-daily-until-on-start-date-yields-one () + "Boundary: UNTIL equal to the start date yields exactly that one occurrence. +The degenerate single-instance series -- a strict comparison returns nothing +at all here, which is the same defect at its smallest." + (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) + (until-date (test-calendar-sync-time-date-only 1)) + (base-event (list :summary "One Shot" :start start-date)) + (rrule (list :freq 'daily :interval 1 :until until-date)) + (range (test-calendar-sync-wide-range)) + (occurrences (calendar-sync--expand-daily base-event rrule range))) + (should (= (length occurrences) 1)) + (should (equal (seq-take (plist-get (car occurrences) :start) 3) until-date)))) + (provide 'test-calendar-sync--expand-daily) ;;; test-calendar-sync--expand-daily.el ends here diff --git a/tests/test-calendar-sync--expand-weekly.el b/tests/test-calendar-sync--expand-weekly.el index a6143bce..0639ca07 100644 --- a/tests/test-calendar-sync--expand-weekly.el +++ b/tests/test-calendar-sync--expand-weekly.el @@ -270,5 +270,33 @@ (should (= (length occurrences) 0))) (test-calendar-sync--expand-weekly-teardown))) +;;; UNTIL is inclusive (RFC 5545 3.3.10) + +(ert-deftest test-calendar-sync--expand-weekly-until-includes-the-until-date () + "Boundary: a weekly occurrence landing ON the UNTIL date is kept. +The weekly loop checks UNTIL in two places -- the outer week-stepping guard +and the per-weekday check inside it -- so it needs its own guard rather than +inheriting the daily one. Fixing the loop without this test left weekly +silently unprotected: reverting the fix failed three daily tests and zero +weekly ones." + (test-calendar-sync--expand-weekly-setup) + (unwind-protect + ;; Omitting :byday makes the series recur on the start date's own weekday, + ;; which anchors UNTIL exactly on an occurrence without hardcoding a date. + (let* ((start-date (test-calendar-sync-time-days-from-now 1 9 0)) + (week-2 (test-calendar-sync-time-date-only 8)) + (until-date (test-calendar-sync-time-date-only 15)) + (week-4 (test-calendar-sync-time-date-only 22)) + (base-event (list :summary "Bounded Weekly" :start start-date)) + (rrule (list :freq 'weekly :interval 1 :until until-date)) + (range (test-calendar-sync-wide-range)) + (occurrences (calendar-sync--expand-weekly base-event rrule range)) + (dates (mapcar (lambda (o) (seq-take (plist-get o :start) 3)) occurrences))) + ;; day+1, +8, +15 are consecutive same-weekday dates; UNTIL is the third. + (should (equal dates (list (seq-take start-date 3) week-2 until-date))) + ;; Inclusivity stops at UNTIL -- the following week is not generated. + (should-not (member week-4 dates))) + (test-calendar-sync--expand-weekly-teardown))) + (provide 'test-calendar-sync--expand-weekly) ;;; test-calendar-sync--expand-weekly.el ends here diff --git a/tests/test-calendar-sync-properties.el b/tests/test-calendar-sync-properties.el index c25bb99f..0b01cbd9 100644 --- a/tests/test-calendar-sync-properties.el +++ b/tests/test-calendar-sync-properties.el @@ -77,12 +77,21 @@ For any COUNT value N, expansion never produces more than N occurrences." ;;; Property 2: UNTIL Boundary +;; These two asserted the wrong invariant until 2026-07-16: they required every +;; occurrence to fall strictly BEFORE UNTIL, which is the exclusive reading RFC +;; 5545 3.3.10 contradicts ("bounds the recurrence rule in an inclusive manner"; +;; a UNTIL synchronized with the recurrence "becomes the last instance"). They +;; were written against the expansion loop's strict `before-date-p' guard and so +;; pinned the very defect that dropped the last instance of every bounded series. +;; The property is on-or-before; the upper bound is what UNTIL is for. + (ert-deftest test-calendar-sync-property-until-bounds-daily () - "Property: No daily occurrence starts on or after UNTIL date." + "Property: no daily occurrence starts after the UNTIL date. +UNTIL is an inclusive bound (RFC 5545 3.3.10), so landing exactly on it is +correct and only a later date violates the property." (dotimes (_ test-calendar-sync-property-trials) (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) (until-days (+ 10 (random 60))) - ;; UNTIL must be date-only (3 elements) for calendar-sync--before-date-p (until-date (test-calendar-sync-time-date-only until-days)) (base-event (list :summary "Until Test" :start start-date)) (rrule (list :freq 'daily :interval 1 :until until-date)) @@ -90,16 +99,35 @@ For any COUNT value N, expansion never produces more than N occurrences." (occurrences (calendar-sync--expand-daily base-event rrule range))) (dolist (occ occurrences) (let ((occ-start (plist-get occ :start))) - (should (calendar-sync--before-date-p + (should (calendar-sync--date-on-or-before-p (list (nth 0 occ-start) (nth 1 occ-start) (nth 2 occ-start)) until-date))))))) +(ert-deftest test-calendar-sync-property-until-bounds-daily-reaches-until () + "Property: a daily series stepping by one day always reaches its UNTIL date. +With interval 1 the recurrence is synchronized with any UNTIL, so the last +instance must be UNTIL itself. This is the half the old exclusive property +could never have caught -- it only bounded from above, so silently dropping +the final occurrence satisfied it." + (dotimes (_ test-calendar-sync-property-trials) + (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) + (until-days (+ 10 (random 60))) + (until-date (test-calendar-sync-time-date-only until-days)) + (base-event (list :summary "Until Test" :start start-date)) + (rrule (list :freq 'daily :interval 1 :until until-date)) + (range (test-calendar-sync-wide-range)) + (occurrences (calendar-sync--expand-daily base-event rrule range)) + (last-start (plist-get (car (last occurrences)) :start))) + (should occurrences) + (should (equal (seq-take last-start 3) until-date))))) + (ert-deftest test-calendar-sync-property-until-bounds-weekly () - "Property: No weekly occurrence starts on or after UNTIL date." + "Property: no weekly occurrence starts after the UNTIL date. +UNTIL is an inclusive bound (RFC 5545 3.3.10), so landing exactly on it is +correct and only a later date violates the property." (dotimes (_ test-calendar-sync-property-trials) (let* ((start-date (test-calendar-sync-time-days-from-now 1 10 0)) (until-days (+ 14 (random 60))) - ;; UNTIL must be date-only (3 elements) for calendar-sync--before-date-p (until-date (test-calendar-sync-time-date-only until-days)) (weekdays (test-calendar-sync-random-weekday-subset)) (base-event (list :summary "Until Test" :start start-date)) @@ -108,7 +136,7 @@ For any COUNT value N, expansion never produces more than N occurrences." (occurrences (calendar-sync--expand-weekly base-event rrule range))) (dolist (occ occurrences) (let ((occ-start (plist-get occ :start))) - (should (calendar-sync--before-date-p + (should (calendar-sync--date-on-or-before-p (list (nth 0 occ-start) (nth 1 occ-start) (nth 2 occ-start)) until-date))))))) |