Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 04:21:24 +00:00
Code Issues Projects Releases Packages Wiki Activity

Improve performance of icalendar-recur.el and its tests

Browse source 
As discussed in Bug#80520.

* test/lisp/calendar/icalendar-recur-tests.el
(icalendar-test-rrule-test-rfc5545-sec3.8.5.3/3)
(icalendar-test-rrule-test-rfc5545-sec3.8.5.3/29)
(icalendar-test-rrule-test-rfc5545-sec3.8.5.3/30)
(icalendar-test-rrule-test-rfc5545-sec3.8.5.3/31)
(icalendar-test-rrule-test-rfc5545-sec3.8.5.3/33)
(icalendar-test-rrule-test-rfc5545-sec3.8.5.3/34)
(icalendar-test-rrule-test-rfc5545-sec3.8.5.3/38): Mark tests expensive.

Abstract the implementation of intervals in icalendar-recur.el.  Don't
store interval NEXT-LOW when it's the same as HIGH.  This reduces
allocations, and shaves about ~20% off the full test suite.

* lisp/calendar/icalendar-recur.el
(icalendar-recur-make-interval)
(icalendar-recur-interval-low)
(icalendar-recur-interval-high)
(icalendar-recur-interval-next): Implement intervals and subintervals as
vectors.  Only store NEXT-LOW when it's non-nil.
(icalendar-recur-find-absolute-interval)
(icalendar-recur-find-daily-interval)
(icalendar-recur-find-weekly-interval)
(icalendar-recur-find-monthly-interval)
(icalendar-recur-find-yearly-interval)
(icalendar-recur-next-interval)
(icalendar-recur-previous-interval)
(icalendar-recur-refine-byyearday)
(icalendar-recur-refine-byweekno)
(icalendar-recur-refine-bymonth)
(icalendar-recur-refine-bymonthday)
(icalendar-recur-refine-byday)
(icalendar-recur-refine-byhour)
(icalendar-recur-refine-byminute)
(icalendar-recur-refine-bysecond)
(icalendar-recur-subintervals-to-date-times)
(icalendar-recur-subintervals-to-dates)
(icalendar-recur-recurrences-in-interval)
(icalendar-recur-recurrences-in-window)
(icalendar-recur--key-from-interval): Use new interval constructor and
accessors.  Don't generate NEXT-LOW when it's the same as HIGH.
* lisp/calendar/icalendar-utils.el (icalendar-dates-until): Use new
interval constructor and accessors.
* test/lisp/calendar/icalendar-recur-tests.el
(icalendar-test-recur-find-secondly-interval)
(icalendar-test-recur-find-minutely-interval)
(icalendar-test-recur-find-hourly-interval)
(icalendar-test-recur-find-daily-interval-w/date)
(icalendar-test-recur-find-daily-interval-w/date-time)
(icalendar-test-recur-find-weekly-interval-w/date)
(icalendar-test-recur-find-weekly-interval-w/date-time)
(icalendar-test-recur-find-monthly-interval)
(icalendar-test-recur-find-yearly-interval)
(icalendar-test-recur-refine-byyearday)
(icalendar-test-recur-refine-bymonth)
(icalendar-test-recur-refine-bymonthday)
(icalendar-test-recur-refine-byday)
(icalendar-test-recur-refine-byhour)
(icalendar-test-recur-refine-byminute)
(icalendar-test-recur-refine-bysecond)
(icalendar-test-recur-subintervals-to-dates)
(icalendar-test-recur-subintervals-to-date-times)
(icalendar-test-rrule-test): Use new interval constructor and accessors.

Rearrange loops when refining subintervals, so that the loop always runs
once but doesn't run a second no-op iteration.  Astonishingly this cuts
the running time of the full test suite by almost 50%.

* lisp/calendar/icalendar-recur.el (icalendar-recur-refine-byyearday)
(icalendar-recur-refine-byweekno)
(icalendar-recur-refine-bymonth)
(icalendar-recur-refine-bymonthday)
(icalendar-recur-refine-byday)
(icalendar-recur-refine-byhour)
(icalendar-recur-refine-byminute)
(icalendar-recur-refine-bysecond): Tighten up loop bounds when refining
subintervals.

Improve performance of `icalendar-recur-tz-observance-on'.  This also
brings about a ~20% performance gain.

* lisp/calendar/icalendar-recur.el
(icalendar-recur-tz-observance-on): Eliminate calculation of previous
interval recurrences when it's unnecessary.  Add a cheap upper bound check to
prevent fully computing recurrences for irrelevant observances.
(icalendar-recur--w/in-locally-p):
(icalendar-recur--w/in-abs-p): New helper functions for the upper bound check.

Other more minor changes:

Improve performance in `icalendar-recur-refine-byday'

* lisp/calendar/icalendar-recur.el (icalendar-recur-refine-byday): Avoid
calculating Gregorian from absolute date unless it's necessary.

Improve performance of BYSETPOS filtering in icalendar-recur.el:
η-reduce `icalendar-recur-make-bysetpos-filter'.
Thanks to Mattias Engdegård for the suggestion and implementation.

* lisp/calendar/icalendar-recur.el
(icalendar-recur-make-bysetpos-filter): Rename to
`icalendar-recur-bysetpos-filter' and avoid `seq-map-indexed'.
(icalendar-recur-recurrences-in-interval): Use new function.
* test/lisp/calendar/icalendar-recur-tests.el
(icalendar-test-recur-bysetpos-filter): Use new function.

Improve sorting performance:
Thanks to Mattias Engdegård for the suggestion and implementation.

* lisp/calendar/icalendar-recur.el (icalendar-recur-refine-byyearday):
(icalendar-recur-refine-byweekno):
(icalendar-recur-refine-bymonthday):
(icalendar-recur-refine-byday): Use :key instead of :lessp in `sort'
calls.

Eliminate `apply-partially' and `seq-take':
Thanks to Mattias Engdegård for the suggestion and implementation.

* lisp/calendar/icalendar-recur.el
(icalendar-recur-recurrences-in-window): Eliminate `apply-partially'.
(icalendar-recur-recurrences-in-interval): Eliminate
`apply-partially' and replace `seq-take' with `take'.

Reduce consing:

* lisp/calendar/icalendar-recur.el
(icalendar-recur-subintervals-to-dates):
(icalendar-recur-recurrences-in-window):
(icalendar-recur-recurrences-in-window-w/end-times):
(icalendar-recur-recurrences-to-count): Replace `append' with `nconc'.

Avoid a few uses of `seq-filter' in common functions in icalendar-ast.el:

* lisp/calendar/icalendar-ast.el (icalendar-ast-node-children-of):
Reimplement filter imperatively.
This commit is contained in:
Richard Lawrence 2026-03-07 12:20:00 +01:00 committed by Eli Zaretskii
parent 386e9598b6
commit 6eea015337
4 changed files with 451 additions and 328 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lisp/calendar/icalendar-ast.el
View file

@ -293,8 +293,11 @@ PROPS should be a plist with any of the following keywords:
(defun ical:ast-node-children-of (type node)
"Return a list of all the children of NODE of type TYPE."
(seq-filter (lambda (c) (eq type (ical:ast-node-type c)))
(ical:ast-node-children node)))
(let (tchildren)
(dolist (c (ical:ast-node-children node))
(when (eq type (ical:ast-node-type c))
(push c tchildren)))
(nreverse tchildren)))
;; A high-level API for constructing iCalendar syntax nodes in Lisp code:

507
lisp/calendar/icalendar-recur.el
View file

@ -131,24 +131,38 @@
;; also in this case, recurrences are generated for one interval at a
;; time, because a BYSETPOS clause might apply.
;;
;; An interval is represented as a list (LOW HIGH NEXT-LOW) of decoded
;; times. The length of time between LOW and HIGH corresponds to the
;; FREQ rule part: they are one year apart for a 'YEARLY rule, a month
;; apart for a 'MONTHLY rule, etc. NEXT-LOW is the upper bound of the
;; interval: it is equal to LOW in the subsequent interval. When the
;; INTERVAL rule part is equal to 1 (the default), HIGH and NEXT-LOW are
;; the same, but if it is > 1, NEXT-LOW is equal to LOW + INTERVAL *
;; FREQ. For example, in a 'MONTHLY rule where INTERVAL=3, which means
;; "every three months", LOW and HIGH bound the first month, while HIGH
;; and NEXT-LOW bound the following two months.
;; An interval is represented as a vector like [LOW HIGH NEXT-LOW] of
;; decoded times. The length of time between LOW and HIGH corresponds
;; to the FREQ rule part: they are one year apart for a 'YEARLY rule, a
;; month apart for a 'MONTHLY rule, etc. NEXT-LOW is the upper bound of
;; the interval: it is equal to LOW in the subsequent interval. When
;; the INTERVAL rule part is equal to 1 (the default), HIGH and NEXT-LOW
;; are the same, but if it is > 1, NEXT-LOW is equal to LOW + INTERVAL *
;; FREQ. (For performance reasons, NEXT-LOW is therefore left out of
;; the vector when it is redundant.) For example, in a 'MONTHLY rule
;; where INTERVAL=3, which means "every three months", LOW and HIGH
;; bound the first month, while HIGH and NEXT-LOW bound the following
;; two months.
;;
;; The times between LOW and HIGH are candidates for recurrences. LOW
;; is an inclusive lower bound, and HIGH is an exclusive upper bound:
;; LOW <= R < HIGH for each recurrence R in the interval. The times
;; between HIGH and NEXT-LOW are not candidates for recurrences.
;;
(defun icr:make-interval (low high &optional next-low)
(if next-low
(vector low high next-low)
(vector low high)))
(defsubst icr:interval-low (interval)
(aref interval 0))
(defsubst icr:interval-high (interval)
(aref interval 1))
(defsubst icr:interval-next (interval)
(aref interval (1- (length interval)))) ; = NEXT-LOW if present, HIGH otherwise
;; The following functions deal with constructing intervals, given a
;; target, a start date/time, and intervalsize, and optionally a time
;; target, a start date/time, an intervalsize, and optionally a time
;; zone. The main entry point is `icalendar-recur-find-interval'.
;; Look, dragons already:
@ -252,7 +266,8 @@ returned interval looks like (LOW LOW+FREQS LOW+INTERVALSIZE). See
(let ((offset (decoded-time-zone target-w/zone)))
(setq low (icr:tz-decode-time low-abs offset)
high (icr:tz-decode-time (+ low-abs freqs) offset)
next-low (icr:tz-decode-time (+ low-abs intervalsize) offset))))
next-low (when (< 1 intervalsize)
(icr:tz-decode-time (+ low-abs intervalsize) offset)))))
(unless (and given-start-zone given-target-zone)
;; but if we started with floating times, we should return floating times:
@ -260,10 +275,11 @@ returned interval looks like (LOW LOW+FREQS LOW+INTERVALSIZE). See
(setf (decoded-time-dst low) -1)
(setf (decoded-time-zone high) nil)
(setf (decoded-time-dst high) -1)
(setf (decoded-time-zone next-low) nil)
(setf (decoded-time-dst next-low) -1))
(when next-low
(setf (decoded-time-zone next-low) nil)
(setf (decoded-time-dst next-low) -1)))
(list low high next-low)))
(icr:make-interval low high next-low)))
(defun icr:find-secondly-interval (target dtstart intervalsize &optional vtimezone)
"Find a SECONDLY recurrence interval.
@ -317,16 +333,18 @@ See `icalendar-recur-find-interval' for arguments' meanings."
(calendar-gregorian-from-absolute low-absdate)))
(high-dt (ical:date-to-date-time
(calendar-gregorian-from-absolute high-absdate)))
(next-low-dt (ical:date-to-date-time
(calendar-gregorian-from-absolute next-low-absdate))))
(next-low-dt (unless (= high-absdate next-low-absdate)
(ical:date-to-date-time
(calendar-gregorian-from-absolute next-low-absdate)))))
(when vtimezone
(icr:tz-set-zone low-dt vtimezone)
(icr:tz-set-zone high-dt vtimezone)
(icr:tz-set-zone next-low-dt vtimezone))
(when next-low-dt
(icr:tz-set-zone next-low-dt vtimezone)))
;; Return the bounds:
(list low-dt high-dt next-low-dt))))
(icr:make-interval low-dt high-dt next-low-dt))))
(defun icr:find-weekly-interval (target dtstart intervalsize
&optional weekstart vtimezone)
@ -358,16 +376,19 @@ See `icalendar-recur-find-interval' for arguments' meanings."
(calendar-gregorian-from-absolute low-abs)))
(high (ical:date-to-date-time
(calendar-gregorian-from-absolute (+ 7 low-abs))))
(next-low (ical:date-to-date-time
(calendar-gregorian-from-absolute (+ intsize-days low-abs)))))
(next-low
(when (< 1 intervalsize)
(ical:date-to-date-time
(calendar-gregorian-from-absolute (+ intsize-days low-abs))))))
(when vtimezone
(icr:tz-set-zone low vtimezone)
(icr:tz-set-zone high vtimezone)
(icr:tz-set-zone next-low vtimezone))
(when next-low
(icr:tz-set-zone next-low vtimezone)))
;; Return the bounds:
(list low high next-low)))
(icr:make-interval low high next-low)))
(defun icr:find-monthly-interval (target dtstart intervalsize &optional vtimezone)
"Find a MONTHLY recurrence interval.
@ -399,10 +420,12 @@ See `icalendar-recur-find-interval' for arguments' meanings."
(low (ical:make-date-time :year low-year :month low-month :day 1
:hour 0 :minute 0 :second 0 :tz vtimezone))
(high (ical:date/time-add low :month 1 vtimezone))
(next-low (ical:date/time-add low :month intervalsize vtimezone)))
(next-low
(when (< 1 intervalsize)
(ical:date/time-add low :month intervalsize vtimezone))))
;; Return the bounds:
(list low high next-low)))
(icr:make-interval low high next-low)))
(defun icr:find-yearly-interval (target dtstart intervalsize &optional vtimezone)
"Find a YEARLY recurrence interval.
@ -417,12 +440,14 @@ See `icalendar-recur-find-interval' for arguments' meanings."
:hour 0 :minute 0 :second 0 :tz vtimezone))
(high (ical:make-date-time :year (1+ low-year) :month 1 :day 1
:hour 0 :minute 0 :second 0 :tz vtimezone))
(next-low (ical:make-date-time :year (+ low-year intervalsize)
:month 1 :day 1 :hour 0 :minute 0 :second 0
:tz vtimezone)))
(next-low
(when (< 1 intervalsize)
(ical:make-date-time :year (+ low-year intervalsize)
:month 1 :day 1 :hour 0 :minute 0 :second 0
:tz vtimezone))))
;; Return the bounds:
(list low high next-low)))
(icr:make-interval low high next-low)))
(defun icr:find-interval (target dtstart recur-value &optional vtimezone)
"Return the recurrence interval around TARGET.
@ -430,7 +455,7 @@ See `icalendar-recur-find-interval' for arguments' meanings."
TARGET and DTSTART should be `icalendar-date' or `icalendar-date-time'
values. RECUR-VALUE should be an `icalendar-recur'.
The returned value is a list (LOW HIGH NEXT-LOW) which
The returned value is an interval [LOW HIGH NEXT-LOW] which
represents the lower and upper bounds of a recurrence interval around
TARGET. For some N, LOW is equal to START + N*INTERVALSIZE units, HIGH
is equal to START + (N+1)*INTERVALSIZE units, and LOW <= TARGET < HIGH.
@ -460,7 +485,7 @@ information and represent floating local times."
(defun icr:nth-interval (n dtstart recur-value &optional vtimezone)
"Return the Nth recurrence interval after DTSTART.
The returned value is a list (LOW HIGH NEXT-LOW) which represent the Nth
The returned value is an interval [LOW HIGH NEXT-LOW] which is the Nth
recurrence interval after DTSTART. LOW is equal to START +
N*INTERVALSIZE units, HIGH is equal to START + (N+1)*INTERVALSIZE units,
and LOW <= TARGET < HIGH. START here is a time derived from DTSTART
@ -498,10 +523,10 @@ information and represent floating local times."
(defun icr:next-interval (interval recur-value &optional vtimezone)
"Return the next recurrence interval after INTERVAL.
Given a recurrence interval (LOW HIGH NEXT), returns the next interval
\(NEXT HIGHER HIGHER-NEXT), where HIGHER and HIGHER-NEXT are determined
Given a recurrence interval [LOW HIGH NEXT], returns the next interval
[NEXT HIGHER HIGHER-NEXT], where HIGHER and HIGHER-NEXT are determined
by the frequency and interval sizes of RECUR-VALUE."
(let* ((new-low (caddr interval))
(let* ((new-low (icr:interval-next interval))
(freq (ical:recur-freq recur-value))
(unit (cl-case freq
(YEARLY :year)
@ -513,7 +538,9 @@ by the frequency and interval sizes of RECUR-VALUE."
(SECONDLY :second)))
(intervalsize (ical:recur-interval-size recur-value))
(new-high (ical:date/time-add new-low unit 1 vtimezone))
(new-next (ical:date/time-add new-low unit intervalsize vtimezone)))
(new-next
(when (< 1 intervalsize)
(ical:date/time-add new-low unit intervalsize vtimezone))))
(when vtimezone
(icr:tz-set-zone new-low vtimezone)
@ -521,18 +548,18 @@ by the frequency and interval sizes of RECUR-VALUE."
;; (icr:tz-set-zone new-next vtimezone)
)
(list new-low new-high new-next)))
(icr:make-interval new-low new-high new-next)))
(defun icr:previous-interval (interval recur-value dtstart &optional vtimezone)
"Given a recurrence INTERVAL, return the previous interval.
For an interval (LOW HIGH NEXT-LOW), the previous interval is
\(PREV-LOW PREV-HIGH LOW), where PREV-LOW and PREV-HIGH are determined by
For an interval [LOW HIGH NEXT-LOW], the previous interval is
[PREV-LOW PREV-HIGH LOW], where PREV-LOW and PREV-HIGH are determined by
the frequency and interval sizes of RECUR-VALUE (see
`icalendar-recur-find-interval'). If the resulting period of time
between PREV-LOW and PREV-HIGH occurs entirely before DTSTART, then the
interval does not exist; in this case nil is returned."
(let* ((upper (car interval))
(let* ((upper (icr:interval-low interval))
(freq (ical:recur-freq recur-value))
(unit (cl-case freq
(YEARLY :year)
@ -544,7 +571,13 @@ interval does not exist; in this case nil is returned."
(SECONDLY :second)))
(intervalsize (ical:recur-interval-size recur-value))
(new-low (ical:date/time-add upper unit (* -1 intervalsize) vtimezone))
(new-high (ical:date/time-add new-low unit 1 vtimezone)))
(new-high
(if (< 1 intervalsize)
(ical:date/time-add new-low unit 1 vtimezone)
upper))
(new-upper
(when (< 1 intervalsize)
upper)))
(when vtimezone
;; (icr:tz-set-zone new-low vtimezone)
@ -552,7 +585,7 @@ interval does not exist; in this case nil is returned."
(icr:tz-set-zone upper vtimezone))
(unless (ical:date-time< new-high dtstart)
(list new-low new-high upper))))
(icr:make-interval new-low new-high new-upper))))
@ -617,21 +650,18 @@ interval does not exist; in this case nil is returned."
YEARDAYS should be a list of values from a recurrence rule's
BYYEARDAY=... clause; see `icalendar-recur' for the possible values."
(let* ((sorted-ydays (sort yeardays
:lessp (lambda (a b)
(let ((pos-a (if (< 0 a) a (+ 366 a)))
(pos-b (if (< 0 b) b (+ 366 b))))
(< pos-a pos-b)))))
(interval-start (car interval))
(start-year (decoded-time-year interval-start))
(interval-end (cadr interval))
:key (lambda (a) (if (< 0 a) a (+ 366 a)))))
(interval-start (icr:interval-low interval))
(curr-year (decoded-time-year interval-start))
(interval-end (icr:interval-high interval))
(end-year (decoded-time-year interval-end))
(subintervals nil))
(while (<= start-year end-year)
(while curr-year
;; For each year in the interval...
(dolist (n sorted-ydays)
;; ...the subinterval is one day long on the nth yearday
(let* ((nthday (calendar-date-from-day-of-year start-year n))
(low (ical:make-date-time :year start-year
(let* ((nthday (calendar-date-from-day-of-year curr-year n))
(low (ical:make-date-time :year curr-year
:month (calendar-extract-month nthday)
:day (calendar-extract-day nthday)
:hour 0 :minute 0 :second 0
@ -648,9 +678,11 @@ BYYEARDAY=... clause; see `icalendar-recur' for the possible values."
(when (and (ical:date-time<= interval-start low)
(ical:date-time< low high)
(ical:date-time<= high interval-end))
(push (list low high) subintervals))))
(setq start-year (1+ start-year)))
(push (icr:make-interval low high) subintervals))))
(setq curr-year (1+ curr-year))
(when (<= end-year curr-year)
;; we're done:
(setq curr-year nil)))
(nreverse subintervals)))
(defun icr:refine-byweekno (interval weeknos &optional weekstart vtimezone)
@ -660,20 +692,17 @@ WEEKNOS should be a list of values from a recurrence rule's
BYWEEKNO=... clause, and WEEKSTART should be the value of its
WKST=... clause (if any). See `icalendar-recur' for the possible values."
(let* ((sorted-weeknos (sort weeknos
:lessp (lambda (a b)
(let ((pos-a (if (< 0 a) a (+ 53 a)))
(pos-b (if (< 0 b) b (+ 53 b))))
(< pos-a pos-b)))))
(interval-start (car interval))
(start-year (decoded-time-year interval-start))
(interval-end (cadr interval))
:key (lambda (a) (if (< 0 a) a (+ 53 a)))))
(interval-start (icr:interval-low interval))
(curr-year (decoded-time-year interval-start))
(interval-end (icr:interval-high interval))
(end-year (decoded-time-year interval-end))
(subintervals nil))
(while (<= start-year end-year)
(while curr-year
;; For each year in the interval...
(dolist (wn sorted-weeknos)
;; ...the subinterval is one week long in the wn-th week
(let* ((nth-wstart (ical:start-of-weekno wn start-year weekstart))
(let* ((nth-wstart (ical:start-of-weekno wn curr-year weekstart))
(low (ical:make-date-time :year (calendar-extract-year nth-wstart)
:month (calendar-extract-month nth-wstart)
:day (calendar-extract-day nth-wstart)
@ -690,8 +719,11 @@ WKST=... clause (if any). See `icalendar-recur' for the possible values."
(when (and (ical:date-time<= interval-start low)
(ical:date-time< low high)
(ical:date-time<= high interval-end))
(push (list low high) subintervals))))
(setq start-year (1+ start-year)))
(push (icr:make-interval low high) subintervals))))
(setq curr-year (1+ curr-year))
(when (<= end-year curr-year)
;; we're done:
(setq curr-year nil)))
(nreverse subintervals)))
(defun icr:refine-bymonth (interval months &optional vtimezone)
@ -700,17 +732,17 @@ WKST=... clause (if any). See `icalendar-recur' for the possible values."
MONTHS should be a list of values from a recurrence rule's
BYMONTH=... clause; see `icalendar-recur' for the possible values."
(let* ((sorted-months (sort months))
(interval-start (car interval))
(start-year (decoded-time-year interval-start))
(interval-end (cadr interval))
(interval-start (icr:interval-low interval))
(curr-year (decoded-time-year interval-start))
(interval-end (icr:interval-high interval))
(end-year (decoded-time-year interval-end))
(subintervals nil))
(while (<= start-year end-year)
(while curr-year
;; For each year in the interval...
(dolist (m sorted-months)
;; ...the subinterval is from the first day of the given month
;; to the first day of the next
(let* ((low (ical:make-date-time :year start-year :month m :day 1
(let* ((low (ical:make-date-time :year curr-year :month m :day 1
:hour 0 :minute 0 :second 0
:tz vtimezone))
(high (ical:date/time-add low :month 1 vtimezone)))
@ -723,9 +755,11 @@ BYMONTH=... clause; see `icalendar-recur' for the possible values."
(when (and (ical:date/time<= interval-start low)
(ical:date/time< low high)
(ical:date/time<= high interval-end))
(push (list low high) subintervals))))
(setq start-year (1+ start-year)))
(push (icr:make-interval low high) subintervals))))
(setq curr-year (1+ curr-year))
(when (<= end-year curr-year)
; we're done:
(setq curr-year nil)))
(nreverse subintervals)))
(defun icr:refine-bymonthday (interval monthdays &optional vtimezone)
@ -734,22 +768,20 @@ BYMONTH=... clause; see `icalendar-recur' for the possible values."
MONTHDAYS should be a list of values from a recurrence rule's
BYMONTHDAY=... clause; see `icalendar-recur' for the possible values."
(let* ((sorted-mdays (sort monthdays
:lessp (lambda (a b)
(let ((pos-a (if (< 0 a) a (+ 31 a)))
(pos-b (if (< 0 b) b (+ 31 b))))
(< pos-a pos-b)))))
(interval-start (car interval))
(interval-end (cadr interval))
:key (lambda (a) (if (< 0 a) a (+ 31 a)))))
(interval-start (icr:interval-low interval))
(curr-dt interval-start)
(interval-end (icr:interval-high interval))
(subintervals nil))
(while (ical:date-time<= interval-start interval-end)
(while curr-dt
;; For each month in the interval...
(dolist (m sorted-mdays)
;; ...the subinterval is one day long on the given monthday
(let* ((month (ical:date/time-month interval-start))
(year (ical:date/time-year interval-start))
(let* ((month (ical:date/time-month curr-dt))
(year (ical:date/time-year curr-dt))
(monthday (if (< 0 m) m
(+ m 1 (calendar-last-day-of-month month year))))
(low (ical:date-time-variant interval-start :day monthday
(low (ical:date-time-variant curr-dt :day monthday
:hour 0 :minute 0 :second 0
:tz vtimezone))
(high (ical:date/time-add low :day 1 vtimezone)))
@ -763,9 +795,11 @@ BYMONTHDAY=... clause; see `icalendar-recur' for the possible values."
(when (and (ical:date/time<= interval-start low)
(ical:date/time< low high)
(ical:date/time<= high interval-end))
(push (list low high) subintervals)))))
(setq interval-start
(ical:date/time-add interval-start :month 1 vtimezone)))
(push (icr:make-interval low high) subintervals)))))
(setq curr-dt (ical:date/time-add curr-dt :month 1 vtimezone))
(when (ical:date-time<= interval-end curr-dt)
;; we're done:
(setq curr-dt nil)))
(nreverse subintervals)))
(defun icr:refine-byday (interval weekdays &optional in-month vtimezone)
@ -779,11 +813,11 @@ whether OFFSET is relative to the month of the start of the interval. If
it is nil, OFFSET will be relative to the year, rather than the month."
(let* ((sorted-weekdays (sort (seq-filter #'natnump weekdays)))
(with-offsets (sort (seq-filter #'consp weekdays)
:lessp (lambda (w1 w2) (and (< (car w1) (car w2))))))
(interval-start (car interval))
(start-abs (calendar-absolute-from-gregorian
(ical:date-time-to-date interval-start)))
(interval-end (cadr interval))
:key #'car))
(interval-start (icr:interval-low interval))
(curr-abs (calendar-absolute-from-gregorian
(ical:date-time-to-date interval-start)))
(interval-end (icr:interval-high interval))
(end-abs (calendar-absolute-from-gregorian
(ical:date-time-to-date interval-end)))
(subintervals nil))
@ -810,15 +844,15 @@ it is nil, OFFSET will be relative to the year, rather than the month."
(when (and (ical:date/time<= interval-start low)
(ical:date/time<= high interval-end)
(ical:date/time< low high))
(push (list low high) subintervals))))
(push (icr:make-interval low high) subintervals))))
;; When no offset was given, for each day in the interval...
(while (and (<= start-abs end-abs)
sorted-weekdays)
(while (and curr-abs sorted-weekdays)
;; ...the subinterval is one day long on matching weekdays.
(let* ((gdate (calendar-gregorian-from-absolute start-abs)))
(when (memq (calendar-day-of-week gdate) sorted-weekdays)
(let* ((low (ical:date-to-date-time gdate))
(when (memq (mod curr-abs 7) ; = weekday of absolute date;
sorted-weekdays) ; see `calendar-day-of-week'
(let* ((gdate (calendar-gregorian-from-absolute curr-abs))
(low (ical:date-to-date-time gdate))
(high (ical:date/time-add low :day 1 vtimezone)))
(when (ical:date/time< low interval-start)
(setq low interval-start))
@ -830,13 +864,16 @@ it is nil, OFFSET will be relative to the year, rather than the month."
(when (and (ical:date/time<= interval-start low)
(ical:date/time<= high interval-end)
(ical:date/time< low high))
(push (list low high) subintervals)))))
(setq start-abs (1+ start-abs)))
(push (icr:make-interval low high) subintervals))))
(setq curr-abs (1+ curr-abs))
(when (<= end-abs curr-abs)
;; we're done:
(setq curr-abs nil)))
;; Finally, sort and return all subintervals:
(sort subintervals
:lessp (lambda (int1 int2)
(ical:date-time< (car int1) (car int2)))
:key #'icr:interval-low
:lessp #'ical:date-time<
:in-place t)))
(defun icr:refine-byhour (interval hours &optional vtimezone)
@ -845,27 +882,31 @@ it is nil, OFFSET will be relative to the year, rather than the month."
HOURS should be a list of values from a recurrence rule's
BYHOUR=... clause; see `icalendar-recur' for the possible values."
(let* ((sorted-hours (sort hours))
(interval-start (car interval))
(interval-end (cadr interval))
(interval-start (icr:interval-low interval))
(interval-end (icr:interval-high interval))
(curr-dt interval-start)
(subintervals nil))
(while (ical:date-time<= interval-start interval-end)
(while curr-dt
;; For each day in the interval...
(dolist (h sorted-hours)
;; ...the subinterval is one hour long in the given hour
(let* ((low (ical:date-time-variant interval-start
(let* ((low (ical:date-time-variant curr-dt
:hour h :minute 0 :second 0
:tz vtimezone))
(high (ical:date/time-add low :hour 1 vtimezone)))
(ignore-errors ; do not generate subintervals for nonexisting times
(when (ical:date/time< low interval-start)
(setq low interval-start))
(when (ical:date/time< low curr-dt)
(setq low curr-dt))
(when (ical:date/time< interval-end high)
(setq high interval-end))
(when (and (ical:date/time<= interval-start low)
(ical:date/time< low high)
(ical:date/time<= high interval-end))
(push (list low high) subintervals)))))
(setq interval-start (ical:date/time-add interval-start :day 1 vtimezone)))
(push (icr:make-interval low high) subintervals)))))
(setq curr-dt (ical:date/time-add curr-dt :day 1 vtimezone))
(when (ical:date-time<= interval-end curr-dt)
;; we're done:
(setq curr-dt nil)))
(nreverse subintervals)))
(defun icr:refine-byminute (interval minutes &optional vtimezone)
@ -874,33 +915,37 @@ BYHOUR=... clause; see `icalendar-recur' for the possible values."
MINUTES should be a list of values from a recurrence rule's
BYMINUTE=... clause; see `icalendar-recur' for the possible values."
(let* ((sorted-minutes (sort minutes))
(interval-start (car interval))
(interval-end (cadr interval))
(interval-start (icr:interval-low interval))
(interval-end (icr:interval-high interval))
;; we use absolute times (in seconds) for the loop variables in
;; case the interval crosses the boundary between two observances:
(low-ts (time-convert (encode-time interval-start) 'integer))
(curr-dt interval-start)
(curr-ts (time-convert (encode-time curr-dt) 'integer))
(end-ts (time-convert (encode-time interval-end) 'integer))
(subintervals nil))
(while (<= low-ts end-ts)
(while curr-ts
;; For each hour in the interval...
(dolist (m sorted-minutes)
;; ...the subinterval is one minute long in the given minute
(let* ((low (ical:date-time-variant interval-start :minute m :second 0
(let* ((low (ical:date-time-variant curr-dt :minute m :second 0
:tz vtimezone))
(high (ical:date/time-add low :minute 1 vtimezone)))
(ignore-errors ; do not generate subintervals for nonexisting times
;; Clip the subinterval, as above
(when (ical:date/time< low interval-start)
(setq low interval-start))
(setq low curr-dt))
(when (ical:date/time< interval-end high)
(setq high interval-end))
(when (and (ical:date/time<= interval-start low)
(ical:date/time< low high)
(ical:date/time<= high interval-end))
(push (list low high) subintervals)))))
(setq low-ts (+ low-ts (* 60 60))
interval-start (if vtimezone (icr:tz-decode-time low-ts vtimezone)
(ical:date/time-add interval-start :hour 1))))
(push (icr:make-interval low high) subintervals)))))
(setq curr-ts (+ curr-ts (* 60 60))
curr-dt (if vtimezone (icr:tz-decode-time curr-ts vtimezone)
(ical:date/time-add curr-dt :hour 1)))
(when (<= end-ts curr-ts)
;; we're done:
(setq curr-ts nil)))
(nreverse subintervals)))
(defun icr:refine-bysecond (interval seconds &optional vtimezone)
@ -909,32 +954,36 @@ BYMINUTE=... clause; see `icalendar-recur' for the possible values."
SECONDS should be a list of values from a recurrence rule's
BYSECOND=... clause; see `icalendar-recur' for the possible values."
(let* ((sorted-seconds (sort seconds))
(interval-start (car interval))
(interval-end (cadr interval))
(interval-start (icr:interval-low interval))
(interval-end (icr:interval-high interval))
;; we use absolute times (in seconds) for the loop variables in
;; case the interval crosses the boundary between two observances:
(low-ts (time-convert (encode-time interval-start) 'integer))
(curr-dt interval-start)
(curr-ts (time-convert (encode-time curr-dt) 'integer))
(end-ts (time-convert (encode-time interval-end) 'integer))
(subintervals nil))
(while (<= low-ts end-ts)
(while curr-ts
;; For each minute in the interval...
(dolist (s sorted-seconds)
;; ...the subinterval is one second long: the given second
(let* ((low (ical:date-time-variant interval-start :second s
(let* ((low (ical:date-time-variant curr-dt :second s
:tz vtimezone))
(high (ical:date/time-add low :second 1 vtimezone)))
(when (ical:date/time< low interval-start)
(setq low interval-start))
(setq low curr-dt))
(when (ical:date/time< interval-end high)
(setq high interval-end))
(when (and (ical:date/time<= interval-start low)
(ical:date/time< low high)
(ical:date/time<= high interval-end))
(push (list low high) subintervals))))
(setq low-ts (+ low-ts 60)
interval-start (if vtimezone
(icr:tz-decode-time low-ts vtimezone)
(ical:date/time-add interval-start :minute 1))))
(push (icr:make-interval low high) subintervals))))
(setq curr-ts (+ curr-ts 60)
curr-dt (if vtimezone
(icr:tz-decode-time curr-ts vtimezone)
(ical:date/time-add curr-dt :minute 1)))
(when (<= end-ts curr-ts)
;; we're done:
(setq curr-ts nil)))
(nreverse subintervals)))
;; TODO: should this just become a generic function, with the above
@ -952,8 +1001,8 @@ BYSECOND=... clause; see `icalendar-recur' for the possible values."
(BYMINUTE (icr:refine-byminute interval values vtimezone))
(BYSECOND (icr:refine-bysecond interval values vtimezone))))
(defun icr:make-bysetpos-filter (setpos)
"Return a filter on values for the indices in SETPOS.
(defun icr:bysetpos-filter (setpos recurrences)
"Filter RECURRENCES on values for the indices in SETPOS.
SETPOS should be a list of positive or negative integers between -366
and 366, indicating a fixed index in a set of recurrences for *one
@ -962,23 +1011,24 @@ an `icalendar-recur'. For example, in a YEARLY recurrence rule with an
INTERVAL of 1, the SETPOS represent indices in the recurrence instances
generated for a single year.
The returned value is a closure which can be called on the list of
recurrences for one interval to filter it by index."
(lambda (dts)
(let* ((len (length dts))
(keep-indices (mapcar
(lambda (pos)
;; sequence indices are 0-based, POS's are 1-based:
(if (< pos 0)
(+ pos len)
(1- pos)))
setpos)))
(delq nil
(seq-map-indexed
(lambda (dt index)
(when (memq index keep-indices)
dt))
dts)))))
The returned value is RECURRENCES filtered by index."
(let* ((len (length recurrences))
(keep-indices (mapcar
(lambda (pos)
;; sequence indices are 0-based, POS's are 1-based:
(if (< pos 0)
(+ pos len)
(1- pos)))
setpos))
(r nil)
(i 0)
(dts recurrences))
(while dts
(when (memq i keep-indices)
(push (car dts) r))
(incf i)
(pop dts))
(nreverse r)))
(defun icr:refine-from-clauses (interval recur-value dtstart
&optional vtimezone)
@ -1099,13 +1149,13 @@ The returned list of recurrences contains one date-time value for each
second of each subinterval."
(let (recurrences)
(dolist (int subintervals)
(let* ((start (car int))
(let* ((start (icr:interval-low int))
(dt start)
;; Use absolute times for the loop in case the subinterval
;; crosses the boundary between two observances.
;; N.B. floating times will be correctly treated as local
;; times by encode-time.
(end (time-convert (encode-time (cadr int)) 'integer))
(end (time-convert (encode-time (icr:interval-high int)) 'integer))
(tick (time-convert (encode-time start) 'integer)))
(while (time-less-p tick end)
(push dt recurrences)
@ -1121,10 +1171,10 @@ The returned list of recurrences contains one date value for each
day of each subinterval."
(let (recurrences)
(dolist (int subintervals)
(let* ((start (car int))
(let* ((start (icr:interval-low int))
(start-abs (calendar-absolute-from-gregorian
(ical:date-time-to-date start)))
(end (cadr int))
(end (icr:interval-high int))
(end-abs (calendar-absolute-from-gregorian
(ical:date-time-to-date end)))
;; end is an exclusive upper bound, but number-sequence
@ -1136,9 +1186,9 @@ day of each subinterval."
(1- end-abs)
end-abs)))
(setq recurrences
(append recurrences
(mapcar #'calendar-gregorian-from-absolute
(number-sequence start-abs bound))))))
(nconc recurrences
(mapcar #'calendar-gregorian-from-absolute
(number-sequence start-abs bound))))))
recurrences))
(defun icr:subintervals-to-recurrences (subintervals dtstart &optional vtimezone)
@ -1162,7 +1212,7 @@ subinterval of the same type as DTSTART."
(defun icr:recurrences-in-interval (interval component &optional vtimezone nmax)
"Return a list of the recurrences of COMPONENT in INTERVAL.
INTERVAL should be a list (LOW HIGH NEXT) of date-times which bound a
INTERVAL should be an interval [LOW HIGH NEXT] of date-times which bound a
single recurrence interval, as returned e.g. by
`icalendar-recur-find-interval'. (To find the recurrences in an
arbitrary window of time, rather than between interval boundaries, see
@ -1209,11 +1259,7 @@ retrieved on subsequent calls with the same arguments."
:zone offset-from
:dst (not (ical:daylight-component-p
component)))))
(cl-labels ((get-interval
(apply-partially #'icr:-set-get-interval component))
(put-interval
(apply-partially #'icr:-set-put-interval component)))
(let ((cached (get-interval interval)))
(let ((cached (icr:-set-get-interval component interval)))
(cond ((eq cached :none) nil)
(cached cached)
(t
@ -1227,8 +1273,7 @@ retrieved on subsequent calls with the same arguments."
(keep-indices (ical:recur-by* 'BYSETPOS recur-value))
(pos-recs
(if keep-indices
(funcall (icr:make-bysetpos-filter keep-indices)
sub-recs)
(icr:bysetpos-filter keep-indices sub-recs)
sub-recs))
;; Remove any recurrences before DTSTART or after UNTIL
;; (both of which are inclusive bounds):
@ -1241,8 +1286,8 @@ retrieved on subsequent calls with the same arguments."
pos-recs))
;; Include any values in the interval from the
;; RDATE property:
(low (car interval))
(high (cadr interval))
(low (icr:interval-low interval))
(high (icr:interval-high interval))
(rdates
(mapcar #'ical:ast-node-value
(apply #'append
@ -1276,11 +1321,12 @@ retrieved on subsequent calls with the same arguments."
;; store more recurrences in the final interval than the
;; COUNT clause allows:
(nmax-recs
(if nmax (seq-take all-recs nmax)
(if nmax (take nmax all-recs)
all-recs)))
;; Store and return the computed recurrences:
(put-interval interval (or nmax-recs :none))
nmax-recs))))))))
(icr:-set-put-interval component interval
(or nmax-recs :none))
nmax-recs)))))))
(defun icr:recurrences-in-window (lower upper component &optional vtimezone)
"Return the recurrences of COMPONENT in the window between LOWER and UPPER.
@ -1320,12 +1366,12 @@ UTC offsets local to that time zone."
vtimezone))
(high-interval (icr:find-interval high-end dtstart recur-value
vtimezone))
(high-intbound (cadr high-interval))
(high-intbound (icr:interval-high high-interval))
(recurrences nil))
(while (ical:date-time< (car curr-interval) high-intbound)
(while (ical:date-time< (icr:interval-low curr-interval) high-intbound)
(setq recurrences
(append
(nconc
(icr:recurrences-in-interval curr-interval component vtimezone)
recurrences))
(setq curr-interval (icr:next-interval curr-interval recur-value
@ -1370,18 +1416,18 @@ the period."
(mapcar #'ical:ast-node-value rdate-nodes)))))
(when (or starts periods)
(seq-uniq
(append (mapcar
(lambda (dt) (list dt (ical:date/time-add-duration
dt duration vtimezone)))
starts)
(mapcar
(lambda (p)
(let ((start (ical:period-start p)))
(list start
(or (ical:period-end p)
(ical:date/time-add-duration
start (ical:period-dur-value p) vtimezone)))))
periods)))))))
(nconc (mapcar
(lambda (dt) (list dt (ical:date/time-add-duration
dt duration vtimezone)))
starts)
(mapcar
(lambda (p)
(let ((start (ical:period-start p)))
(list start
(or (ical:period-end p)
(ical:date/time-add-duration
start (ical:period-dur-value p) vtimezone)))))
periods)))))))
(defun icr:recurrences-to-count (component &optional vtimezone)
"Return all the recurrences in COMPONENT up to COUNT in its recurrence rule.
@ -1418,8 +1464,8 @@ UTC offsets local to that time zone."
recs)
(while (length< recs count)
(setq recs
(append recs (icr:recurrences-in-interval int component vtimezone
(- count (length recs)))))
(nconc recs (icr:recurrences-in-interval int component vtimezone
(- count (length recs)))))
(setq int (icr:next-interval int recur-value vtimezone)))
recs)))
@ -1455,7 +1501,7 @@ UTC offsets local to that time zone."
(make-hash-table :test #'equal))
(defsubst icr:-key-from-interval (interval)
(take 6 (car interval))) ; (secs mins hours day month year)
(take 6 (icr:interval-low interval))) ; (secs mins hours day month year)
(defun icr:-set-get-interval (component interval)
(let ((set (ical:ast-node-meta-get :recurrence-set component))
@ -1636,6 +1682,24 @@ should be a time zone identifier, as found e.g. in an
(when (equal tzidval tzid)
(throw 'found tz))))))
(defun icr:-w/in-locally-p (dt start &optional end)
"Check whether DT falls after START (and before END, if any).
All three values must be `icalendar-date-time's. The check is performed with
`icalendar-date-time-locally<='."
(and
(ical:date-time-locally<= start dt)
(or (not end)
(ical:date-time-locally<= dt end))))
(defun icr:-w/in-abs-p (dt start &optional end)
"Check whether DT falls after START (and before END, if any).
DT must be a Lisp time stamp and START and END must be `icalendar-date-time's.
The check is performed with `icalendar-time<='."
(and
(ical:time<= (encode-time start) dt)
(or (not end)
(ical:time<= dt (encode-time end)))))
;; DRAGONS DRAGONS DRAGONS
(defun icr:tz-observance-on (dt vtimezone &optional update nonexisting)
"Return the time zone observance in effect on DT in VTIMEZONE.
@ -1715,10 +1779,27 @@ ignored."
(effective-start
(ical:date-time-variant start :zone offset-from
:dst (not is-daylight)))
(until (ical:recur-until recur-value))
(bound
;; Optimization: compute a rough upper bound for when
;; an observance might apply, thus allowing us to skip
;; computing recurrences for irrelevant observances.
;; The UNTIL date, if any, is the last *recurrence* of
;; the observance. The observance is therefore in
;; effect for some time after this recurrence, so we
;; can't just use UNTIL as an upper bound, but it's
;; guaranteed to end within N years after UNTIL, where
;; N is the interval size. This is not the tightest
;; possible bound but it is the cheapest to compute here.
(when until
(ical:date-time-variant until
:year (+ (decoded-time-year until)
(ical:recur-interval-size
recur-value)))))
(observance-might-apply
(if given-clock-time
(ical:date-time-locally<= effective-start given-clock-time)
(ical:time<= (encode-time effective-start) given-abs-time))))
(icr:-w/in-locally-p given-clock-time effective-start bound)
(icr:-w/in-abs-p given-abs-time effective-start bound))))
(when observance-might-apply
;; Initialize our return values on the first iteration
@ -1781,31 +1862,37 @@ ignored."
(decode-time given-abs-time offset-from)))
(int (icr:find-interval
target effective-start recur-value offset-from))
(int-recs (icr:recurrences-in-interval
int obs offset-from))
;; The closest observance onset before `dt' might
;; actually be in the previous interval, e.g.
;; if `dt' is in January after an annual change to
;; Standard Time in November. So check that as well.
(prev-int (icr:previous-interval int recur-value
effective-start
offset-from))
(prev-recs (when prev-int
(icr:recurrences-in-interval
prev-int obs offset-from)))
(recs (append prev-recs int-recs))
(keep-recs<=given
(<=given
(if given-clock-time
(lambda (rec)
(ical:date-time-locally<= rec given-clock-time))
(lambda (rec)
(ical:time<= (encode-time rec) given-abs-time))))
(srecs (sort (seq-filter ; (1)
keep-recs<=given
recs)
(int-recs (sort
(seq-filter <=given ; (1)
(icr:recurrences-in-interval
int obs offset-from))
:lessp #'ical:date-time<
:in-place t :reverse t))
(latest-rec (car srecs)))
latest-rec)
(unless int-recs
;; The closest observance onset before `dt' might
;; actually be in the previous interval, e.g.
;; if `dt' is in January after an annual change to
;; Standard Time in November. So check that as well.
(setq int (icr:previous-interval int recur-value
effective-start
offset-from))
(setq int-recs
(when int
(sort
(seq-filter <=given ; (1)
(icr:recurrences-in-interval
int obs offset-from))
:lessp #'ical:date-time<
:in-place t :reverse t))))
(setq latest-rec (car int-recs))
(when (and latest-rec
(ical:date-time< nearest-onset latest-rec)) ; (2)
@ -1974,8 +2061,8 @@ called recursively on NODE's children."
:duration (ical:period-dur-value value)))))
(ical:ast-node-set-value value-node updated)))))
((ical:component-node-p node) ; includes VCALENDAR nodes
(mapc (apply-partially #'icr:tz-set-zones-in vtimezones)
(ical:ast-node-children node)))
(dolist (nd (ical:ast-node-children node))
(icr:tz-set-zones-in vtimezones nd)))
(t nil)))
(defun icr:tzname-on (dt vtimezone)

16
lisp/calendar/icalendar-utils.el
View file

@ -561,6 +561,7 @@ interpreted into Emacs local time, so that the dates returned are valid
for the local time zone."
(require 'icalendar-recur) ; avoid circular requires
(declare-function icalendar-recur-subintervals-to-dates "icalendar-recur")
(declare-function icalendar-recur-make-interval "icalendar-recur")
(when locally
(when (cl-typep start 'ical:date-time)
@ -572,18 +573,23 @@ for the local time zone."
(cl-typecase end
(ical:date
(icalendar-recur-subintervals-to-dates
(list (list (ical:date-to-date-time start)
(ical:date-to-date-time end)))))
(list
(icalendar-recur-make-interval
(ical:date-to-date-time start)
(ical:date-to-date-time end)))))
(ical:date-time
(icalendar-recur-subintervals-to-dates
(list (list (ical:date-to-date-time start) end))))))
(list
(icalendar-recur-make-interval (ical:date-to-date-time start) end))))))
(ical:date-time
(cl-typecase end
(ical:date
(icalendar-recur-subintervals-to-dates
(list (list start (ical:date-to-date-time end)))))
(list
(icalendar-recur-make-interval start (ical:date-to-date-time end)))))
(ical:date-time
(icalendar-recur-subintervals-to-dates (list (list start end))))))))
(icalendar-recur-subintervals-to-dates
(list (icalendar-recur-make-interval start end))))))))
(cl-defun ical:make-date-time (&key second minute hour day month year

249
test/lisp/calendar/icalendar-recur-tests.el
View file

@ -117,13 +117,12 @@ END:VTIMEZONE
;; Tests for basic functions:
(ert-deftest ict:recur-bysetpos-filter ()
"Test that `icr:make-bysetpos-filter' filters correctly by position"
"Test that `icr:bysetpos-filter' filters correctly by position"
(let* ((t1 (list 1 1 2024))
(t2 (list 2 1 2024))
(t3 (list 12 30 2024))
(dts (list t1 t2 t3))
(filter (icr:make-bysetpos-filter (list 1 -1)))
(filtered (funcall filter dts)))
(filtered (icr:bysetpos-filter (list 1 -1) dts)))
(should (member t1 filtered))
(should (member t3 filtered))
(should-not (member t2 filtered))))
@ -282,7 +281,7 @@ END:VTIMEZONE
;; an interval boundary:
(let* ((target (ical:date-time-variant dtstart :year 2026 :second 5 :zone 0))
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :second 0 :tz 'preserve)
(ical:date-time-variant target :second 1 :tz 'preserve)
(ical:date-time-variant target :second 10 :tz 'preserve))))
@ -294,7 +293,7 @@ END:VTIMEZONE
;; an interval boundary:
(let* ((target (ical:date-time-variant dtstart :year 2027 :second 10 :zone 0))
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :second 10 :tz 'preserve)
(ical:date-time-variant target :second 11 :tz 'preserve)
(ical:date-time-variant target :second 20 :tz 'preserve))))
@ -308,7 +307,7 @@ END:VTIMEZONE
:year 2028 :month 2 :second 20
:zone ict:est :dst nil))
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :second 20 :tz 'preserve)
(ical:date-time-variant target :second 21 :tz 'preserve)
(ical:date-time-variant target :second 30 :tz 'preserve))))
@ -323,7 +322,7 @@ END:VTIMEZONE
:year 2029 :month 5 :second 30
:zone ict:edt :dst t))
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :second 30 :tz 'preserve)
(ical:date-time-variant target :second 31 :tz 'preserve)
(ical:date-time-variant target :second 40 :tz 'preserve))))
@ -342,7 +341,7 @@ END:VTIMEZONE
:hour 2 :minute 30 :second 0
:zone ict:est :dst nil))
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :hour 3 :second 0
:zone ict:edt :dst t)
(ical:date-time-variant target :hour 3 :second 1
@ -364,7 +363,7 @@ END:VTIMEZONE
:zone ict:edt :dst t))
(intsize 59)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :hour 11 :minute 59 :second 16
:tz 'preserve)
(ical:date-time-variant target :hour 11 :minute 59 :second 17
@ -393,7 +392,7 @@ END:VTIMEZONE
(let* ((target (ical:date-time-variant dtstart :year 2026 :minute 5))
(intsize 10)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :minute 0 :second 0)
(ical:date-time-variant target :minute 1 :second 0)
(ical:date-time-variant target :minute 10 :second 0))))
@ -406,7 +405,7 @@ END:VTIMEZONE
(let* ((target (ical:date-time-variant dtstart :year 2027 :minute 10))
(intsize 10)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :minute 10 :second 0)
(ical:date-time-variant target :minute 11 :second 0)
(ical:date-time-variant target :minute 20 :second 0))))
@ -421,7 +420,7 @@ END:VTIMEZONE
:zone ict:est :dst nil))
(intsize 10)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :minute 20 :second 0
:zone ict:est :dst nil)
(ical:date-time-variant target :minute 21 :second 0
@ -440,7 +439,7 @@ END:VTIMEZONE
:zone ict:edt :dst t))
(intsize 10)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :minute 30 :second 0
:zone ict:edt :dst t)
(ical:date-time-variant target :minute 31 :second 0
@ -464,7 +463,7 @@ END:VTIMEZONE
:zone ict:est :dst nil))
(intsize 10)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :hour 3 :minute 30 :second 0
:zone ict:edt :dst t)
(ical:date-time-variant target :hour 3 :minute 31 :second 0
@ -493,7 +492,7 @@ END:VTIMEZONE
(let* ((target (ical:date-time-variant dtstart :year 2026 :hour 5))
(intsize 10)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :hour 1 :minute 0 :second 0)
(ical:date-time-variant target :hour 10 :minute 0 :second 0))))
@ -506,7 +505,7 @@ END:VTIMEZONE
(let* ((target (ical:date-time-variant dtstart :year 2027 :hour 10))
(intsize 10)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :hour 10 :minute 0 :second 0)
(ical:date-time-variant target :hour 11 :minute 0 :second 0)
(ical:date-time-variant target :hour 20 :minute 0 :second 0))))
@ -521,7 +520,7 @@ END:VTIMEZONE
:zone ict:est :dst nil))
(intsize 2)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :hour 10 :minute 0 :second 0
:zone ict:est :dst nil)
(ical:date-time-variant target :hour 11 :minute 0 :second 0
@ -543,7 +542,7 @@ END:VTIMEZONE
:zone ict:edt :dst t))
(intsize 2)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :hour 11 :minute 0 :second 0
:zone ict:edt :dst t)
(ical:date-time-variant target :hour 12 :minute 0 :second 0
@ -566,7 +565,7 @@ END:VTIMEZONE
:zone ict:est :dst nil))
(intsize 2)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :hour 3 :minute 0 :second 0
:zone ict:edt :dst t)
(ical:date-time-variant target :hour 4 :minute 0 :second 0
@ -590,7 +589,7 @@ END:VTIMEZONE
(let* ((target (list 1 9 2026))
(intsize 7)
(expected-int
(list
(icr:make-interval
(ical:make-date-time :year 2026 :month 1 :day 7
:hour 0 :minute 0 :second 0)
(ical:make-date-time :year 2026 :month 1 :day 8
@ -617,7 +616,7 @@ END:VTIMEZONE
:year 2026 :month 1 :day 9))
(intsize 7)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :day 7 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :day 8 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :day 14
@ -631,7 +630,7 @@ END:VTIMEZONE
(let* ((target (ical:date-time-variant dtstart :year 2027 :month 1 :day 6))
(intsize 7)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :day 6 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :day 7 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :day 13 :hour 0 :minute 0 :second 0))))
@ -645,7 +644,7 @@ END:VTIMEZONE
:zone ict:est :dst nil))
(intsize 7)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :day 2 :hour 0 :minute 0 :second 0
:tz 'preserve)
(ical:date-time-variant target :day 3 :hour 0 :minute 0 :second 0
@ -663,7 +662,7 @@ END:VTIMEZONE
:zone ict:edt :dst t))
(intsize 7)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :day 23 :hour 0 :minute 0 :second 0
:tz 'preserve)
(ical:date-time-variant target :day 24 :hour 0 :minute 0 :second 0
@ -687,7 +686,7 @@ END:VTIMEZONE
(let* ((target '(1 9 2026))
(intsize 2)
(expected-int-mon
(list
(icr:make-interval
(ical:make-date-time :year 2026 :month 1 :day 5
:hour 0 :minute 0 :second 0)
(ical:make-date-time :year 2026 :month 1 :day 12
@ -714,13 +713,13 @@ END:VTIMEZONE
(weds 3)
;; expected interval for Monday (default) week start:
(expected-int-mon
(list
(icr:make-interval
(ical:date-time-variant target :day 5 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :day 12 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :day 19 :hour 0 :minute 0 :second 0)))
;; expected interval for Wednesday week start:
(expected-int-wed
(list
(icr:make-interval
(ical:date-time-variant target :day 7 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :day 14 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :day 21 :hour 0 :minute 0 :second 0))))
@ -736,7 +735,7 @@ END:VTIMEZONE
(intsize 3)
;; expected interval for Monday (default) week start:
(expected-int-mon
(list
(icr:make-interval
(ical:date-time-variant target :year 2026 :month 12 :day 21
:hour 0 :minute 0 :second 0)
(ical:date-time-variant target :year 2026 :month 12 :day 28
@ -753,7 +752,7 @@ END:VTIMEZONE
(sun 0)
;; expected interval for Sunday week start:
(expected-int-sun
(list
(icr:make-interval
(ical:date-time-variant target :day 2 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :day 9 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :day 23 :hour 0 :minute 0 :second 0))))
@ -771,7 +770,7 @@ END:VTIMEZONE
(target '(10 9 2025))
(intsize 5)
(expected-int
(list
(icr:make-interval
(ical:make-date-time :year 2025 :month 6 :day 1
:hour 0 :minute 0 :second 0)
(ical:make-date-time :year 2025 :month 7 :day 1
@ -789,7 +788,7 @@ END:VTIMEZONE
(target (ical:date-time-variant dtstart :year 2026 :month 3 :day 9))
(intsize 2)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :day 1 :hour 0 :minute 0 :second 0)
(ical:date-time-variant target :month 4 :day 1
:hour 0 :minute 0 :second 0)
@ -807,7 +806,7 @@ END:VTIMEZONE
(target (ical:date-time-variant dtstart :year 2027 :month 5 :day 1))
(intsize 7)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :year 2027 :month 5 :day 1
:hour 0 :minute 0 :second 0)
(ical:date-time-variant target :year 2027 :month 6 :day 1
@ -826,7 +825,7 @@ END:VTIMEZONE
:year 2029 :month 4 :day 15))
(intsize 2)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :year 2029 :month 3 :day 1
:hour 0 :minute 0 :second 0)
(ical:date-time-variant target :year 2029 :month 4 :day 1
@ -845,7 +844,7 @@ END:VTIMEZONE
:year 2030 :month 5 :day 1))
(intsize 2)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :year 2030 :month 5 :day 1
:hour 0 :minute 0 :second 0)
(ical:date-time-variant target :year 2030 :month 6 :day 1
@ -863,7 +862,7 @@ END:VTIMEZONE
(target (ical:date-time-variant dtstart :year 2032 :month 11 :day 11))
(intsize 2)
(expected-int
(list
(icr:make-interval
(ical:date-time-variant target :year 2032 :month 11 :day 1
:hour 0 :minute 0 :second 0)
(ical:date-time-variant target :year 2032 :month 12 :day 1
@ -884,7 +883,7 @@ END:VTIMEZONE
(target '(10 9 2025))
(intsize 2)
(expected-int
(list
(icr:make-interval
(ical:make-date-time :year 2025 :month 1 :day 1
:hour 0 :minute 0 :second 0)
(ical:make-date-time :year 2026 :month 1 :day 1
@ -901,7 +900,7 @@ END:VTIMEZONE
:hour 11 :minute 58 :second 0))
(intsize 3)
(expected-int
(list
(icr:make-interval
(ical:make-date-time :year 2026 :month 1 :day 1
:hour 0 :minute 0 :second 0)
(ical:make-date-time :year 2027 :month 1 :day 1
@ -918,7 +917,7 @@ END:VTIMEZONE
:hour 0 :minute 0 :second 0))
(intsize 4)
(expected-int
(list
(icr:make-interval
(ical:make-date-time :year 2027 :month 1 :day 1
:hour 0 :minute 0 :second 0)
(ical:make-date-time :year 2028 :month 1 :day 1
@ -937,13 +936,12 @@ END:VTIMEZONE
:hour 11 :minute 58 :second 0))
(intsize 1)
(expected-int
(list
(icr:make-interval
(ical:make-date-time :year 2029 :month 1 :day 1
:hour 0 :minute 0 :second 0)
(ical:make-date-time :year 2030 :month 1 :day 1
:hour 0 :minute 0 :second 0)
(ical:make-date-time :year 2030 :month 1 :day 1
:hour 0 :minute 0 :second 0))))
nil)))
(should (equal expected-int
(icr:find-yearly-interval target dtstart intsize)))))
@ -954,12 +952,14 @@ END:VTIMEZONE
(let* ((low (ical:make-date-time :year 2025 :month 1 :day 1
:hour 0 :minute 0 :second 0))
(high (ical:date/time-add low :year 1))
(interval (list low high high))
(interval (icr:make-interval low high high))
(yeardays (list 2 -7))
(sub1 (list (ical:date-time-variant low :day 2)
(ical:date-time-variant low :day 3)))
(sub2 (list (ical:date-time-variant low :month 12 :day 25)
(ical:date-time-variant low :month 12 :day 26)))
(sub1 (icr:make-interval
(ical:date-time-variant low :day 2)
(ical:date-time-variant low :day 3)))
(sub2 (icr:make-interval
(ical:date-time-variant low :month 12 :day 25)
(ical:date-time-variant low :month 12 :day 26)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-byyearday interval yeardays)))))
@ -969,12 +969,14 @@ END:VTIMEZONE
(let* ((low (ical:make-date-time :year 2025 :month 1 :day 1
:hour 0 :minute 0 :second 0))
(high (ical:date/time-add low :year 1))
(interval (list low high high))
(interval (icr:make-interval low high high))
(months (list 9 2))
(sub1 (list (ical:date-time-variant low :month 2 :day 1)
(ical:date-time-variant low :month 3 :day 1)))
(sub2 (list (ical:date-time-variant low :month 9 :day 1)
(ical:date-time-variant low :month 10 :day 1)))
(sub1 (icr:make-interval
(ical:date-time-variant low :month 2 :day 1)
(ical:date-time-variant low :month 3 :day 1)))
(sub2 (icr:make-interval
(ical:date-time-variant low :month 9 :day 1)
(ical:date-time-variant low :month 10 :day 1)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-bymonth interval months)))))
@ -984,13 +986,15 @@ END:VTIMEZONE
(let* ((low (ical:make-date-time :year 2025 :month 2 :day 1
:hour 0 :minute 0 :second 0))
(high (ical:date/time-add low :month 1))
(interval (list low high high))
(interval (icr:make-interval low high high))
(monthdays (list -1 2 29))
;; N.B. we should get no subinterval for Feb. 29, 2025
(sub1 (list (ical:date-time-variant low :day 2)
(ical:date-time-variant low :day 3)))
(sub2 (list (ical:date-time-variant low :day 28)
(ical:date-time-variant low :month 3 :day 1)))
(sub1 (icr:make-interval
(ical:date-time-variant low :day 2)
(ical:date-time-variant low :day 3)))
(sub2 (icr:make-interval
(ical:date-time-variant low :day 28)
(ical:date-time-variant low :month 3 :day 1)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-bymonthday interval monthdays)))))
@ -1001,12 +1005,14 @@ END:VTIMEZONE
(let* ((low (ical:make-date-time :year 2025 :month 3 :day 3 ; a Monday
:hour 0 :minute 0 :second 0))
(high (ical:date/time-add low :day 7))
(interval (list low high high))
(interval (icr:make-interval low high high))
(days (list 0 6)) ; just the weekend, please!
(sub1 (list (ical:date-time-variant low :day 8)
(ical:date-time-variant low :day 9)))
(sub2 (list (ical:date-time-variant low :day 9)
(ical:date-time-variant low :day 10)))
(sub1 (icr:make-interval
(ical:date-time-variant low :day 8)
(ical:date-time-variant low :day 9)))
(sub2 (icr:make-interval
(ical:date-time-variant low :day 9)
(ical:date-time-variant low :day 10)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-byday interval days))))
@ -1015,12 +1021,14 @@ END:VTIMEZONE
(let* ((low (ical:make-date-time :year 2025 :month 3 :day 1 ; a Saturday
:hour 0 :minute 0 :second 0))
(high (ical:date/time-add low :month 1))
(interval (list low high high))
(interval (icr:make-interval low high high))
(days (list '(1 . 2) '(1 . -1))) ; second and last Monday
(sub1 (list (ical:date-time-variant low :day 10)
(ical:date-time-variant low :day 11)))
(sub2 (list (ical:date-time-variant low :day 31)
(ical:date-time-variant low :month 4 :day 1)))
(sub1 (icr:make-interval
(ical:date-time-variant low :day 10)
(ical:date-time-variant low :day 11)))
(sub2 (icr:make-interval
(ical:date-time-variant low :day 31)
(ical:date-time-variant low :month 4 :day 1)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-byday interval days t))))
@ -1029,12 +1037,14 @@ END:VTIMEZONE
(let* ((low (ical:make-date-time :year 2025 :month 1 :day 1
:hour 0 :minute 0 :second 0))
(high (ical:date/time-add low :year 1))
(interval (list low high high))
(interval (icr:make-interval low high high))
(days (list '(5 . 1) '(5 . -1))) ; first and last Friday
(sub1 (list (ical:date-time-variant low :day 3)
(ical:date-time-variant low :day 4)))
(sub2 (list (ical:date-time-variant low :month 12 :day 26)
(ical:date-time-variant low :month 12 :day 27)))
(sub1 (icr:make-interval
(ical:date-time-variant low :day 3)
(ical:date-time-variant low :day 4)))
(sub2 (icr:make-interval
(ical:date-time-variant low :month 12 :day 26)
(ical:date-time-variant low :month 12 :day 27)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-byday interval days nil)))))
@ -1045,12 +1055,14 @@ END:VTIMEZONE
(let* ((low (ical:make-date-time :year 2025 :month 1 :day 1
:hour 0 :minute 0 :second 0))
(high (ical:date/time-add low :day 1))
(interval (list low high high))
(interval (icr:make-interval low high high))
(hours (list 2 19))
(sub1 (list (ical:date-time-variant low :hour 2)
(ical:date-time-variant low :hour 3)))
(sub2 (list (ical:date-time-variant low :hour 19)
(ical:date-time-variant low :hour 20)))
(sub1 (icr:make-interval
(ical:date-time-variant low :hour 2)
(ical:date-time-variant low :hour 3)))
(sub2 (icr:make-interval
(ical:date-time-variant low :hour 19)
(ical:date-time-variant low :hour 20)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-byhour interval hours))))
@ -1060,12 +1072,14 @@ END:VTIMEZONE
:hour 0 :minute 0 :second 0
:zone ict:est :dst nil))
(high (ical:date/time-add low :day 1 ict:tz-eastern))
(interval (list low high high))
(interval (icr:make-interval low high high))
(hours (list 2 19))
(sub1 (list (ical:date-time-variant low :hour 2 :tz 'preserve)
(ical:date-time-variant low :hour 3 :tz 'preserve)))
(sub2 (list (ical:date-time-variant low :hour 19 :tz 'preserve)
(ical:date-time-variant low :hour 20 :tz 'preserve)))
(sub1 (icr:make-interval
(ical:date-time-variant low :hour 2 :tz 'preserve)
(ical:date-time-variant low :hour 3 :tz 'preserve)))
(sub2 (icr:make-interval
(ical:date-time-variant low :hour 19 :tz 'preserve)
(ical:date-time-variant low :hour 20 :tz 'preserve)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-byhour interval hours ict:tz-eastern)))))
@ -1076,12 +1090,14 @@ END:VTIMEZONE
(let* ((low (ical:make-date-time :year 2025 :month 5 :day 1
:hour 13 :minute 0 :second 0))
(high (ical:date/time-add low :hour 1))
(interval (list low high high))
(interval (icr:make-interval low high high))
(minutes (list 7 59))
(sub1 (list (ical:date-time-variant low :minute 7)
(ical:date-time-variant low :minute 8)))
(sub2 (list (ical:date-time-variant low :minute 59)
(ical:date-time-variant low :hour 14 :minute 0)))
(sub1 (icr:make-interval
(ical:date-time-variant low :minute 7)
(ical:date-time-variant low :minute 8)))
(sub2 (icr:make-interval
(ical:date-time-variant low :minute 59)
(ical:date-time-variant low :hour 14 :minute 0)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-byminute interval minutes))))
@ -1091,13 +1107,14 @@ END:VTIMEZONE
:hour 13 :minute 0 :second 0
:zone ict:est :dst nil))
(high (ical:date/time-add low :hour 1 ict:tz-eastern))
(interval (list low high high))
(interval (icr:make-interval low high high))
(minutes (list 7 59))
(sub1 (list (ical:date-time-variant low :minute 7 :tz 'preserve)
(ical:date-time-variant low :minute 8 :tz 'preserve)))
(sub2 (list (ical:date-time-variant low :minute 59 :tz 'preserve)
(ical:date-time-variant low :hour 14 :minute 0
:tz 'preserve)))
(sub1 (icr:make-interval
(ical:date-time-variant low :minute 7 :tz 'preserve)
(ical:date-time-variant low :minute 8 :tz 'preserve)))
(sub2 (icr:make-interval
(ical:date-time-variant low :minute 59 :tz 'preserve)
(ical:date-time-variant low :hour 14 :minute 0 :tz 'preserve)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-byminute interval minutes ict:tz-eastern)))))
@ -1108,12 +1125,14 @@ END:VTIMEZONE
(let* ((low (ical:make-date-time :year 2025 :month 5 :day 1
:hour 13 :minute 59 :second 0))
(high (ical:date/time-add low :minute 1))
(interval (list low high high))
(interval (icr:make-interval low high high))
(seconds (list 24 59))
(sub1 (list (ical:date-time-variant low :second 24)
(ical:date-time-variant low :second 25)))
(sub2 (list (ical:date-time-variant low :second 59)
(ical:date-time-variant low :hour 14 :minute 0 :second 0)))
(sub1 (icr:make-interval
(ical:date-time-variant low :second 24)
(ical:date-time-variant low :second 25)))
(sub2 (icr:make-interval
(ical:date-time-variant low :second 59)
(ical:date-time-variant low :hour 14 :minute 0 :second 0)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-bysecond interval seconds))))
@ -1123,13 +1142,14 @@ END:VTIMEZONE
:hour 13 :minute 19 :second 0
:zone ict:est :dst nil))
(high (ical:date/time-add low :minute 1 ict:tz-eastern))
(interval (list low high high))
(interval (icr:make-interval low high high))
(seconds (list 24 59))
(sub1 (list (ical:date-time-variant low :second 24 :tz 'preserve)
(ical:date-time-variant low :second 25 :tz 'preserve)))
(sub2 (list (ical:date-time-variant low :second 59 :tz 'preserve)
(ical:date-time-variant low :minute 20 :second 0
:tz 'preserve)))
(sub1 (icr:make-interval
(ical:date-time-variant low :second 24 :tz 'preserve)
(ical:date-time-variant low :second 25 :tz 'preserve)))
(sub2 (icr:make-interval
(ical:date-time-variant low :second 59 :tz 'preserve)
(ical:date-time-variant low :minute 20 :second 0 :tz 'preserve)))
(expected-subintervals (list sub1 sub2)))
(should (equal expected-subintervals
(icr:refine-bysecond interval seconds ict:tz-eastern)))))
@ -1140,11 +1160,11 @@ END:VTIMEZONE
(let* ((low1 (ical:make-date-time :year 2025 :month 5 :day 1
:hour 13 :minute 59 :second 0))
(high1 (ical:date/time-add low1 :day 3))
(sub1 (list low1 high1))
(sub1 (icr:make-interval low1 high1))
(low2 (ical:make-date-time :year 2025 :month 5 :day 31
:hour 14 :minute 0 :second 0))
(high2 (ical:date/time-add low2 :hour 3)) ; later but on the same day
(sub2 (list low2 high2))
(sub2 (icr:make-interval low2 high2))
(low-date1 (ical:date-time-to-date low1))
(low-date2 (ical:date-time-to-date low2))
(expected-recs (list low-date1
@ -1161,11 +1181,11 @@ END:VTIMEZONE
(let* ((low1 (ical:make-date-time :year 2025 :month 5 :day 1
:hour 13 :minute 59 :second 0))
(high1 (ical:date/time-add low1 :second 1))
(sub1 (list low1 high1))
(sub1 (icr:make-interval low1 high1))
(low2 (ical:make-date-time :year 2025 :month 5 :day 2
:hour 14 :minute 0 :second 0))
(high2 (ical:date/time-add low2 :second 1))
(sub2 (list low2 high2))
(sub2 (icr:make-interval low2 high2))
(expected-recs (list low1 low2)))
(should (equal expected-recs
(icr:subintervals-to-date-times (list sub1 sub2)))))
@ -1175,7 +1195,7 @@ END:VTIMEZONE
:hour 13 :minute 59 :second 0
:zone ict:edt :dst t))
(high1 (ical:date/time-add low1 :second 5 ict:tz-eastern))
(sub1 (list low1 high1))
(sub1 (icr:make-interval low1 high1))
(expected-recs
(list low1
(ical:date/time-add low1 :second 1 ict:tz-eastern)
@ -1194,7 +1214,7 @@ END:VTIMEZONE
(high1 (ical:make-date-time :year 2025 :month 3 :day 9
:hour 3 :minute 0 :second 3
:zone ict:edt :dst t))
(sub1 (list low1 high1))
(sub1 (icr:make-interval low1 high1))
(expected-recs
(list low1
(ical:date-time-variant low1 :second 59 :tz 'preserve)
@ -1214,7 +1234,7 @@ END:VTIMEZONE
(high1 (ical:make-date-time :year 2024 :month 11 :day 3
:hour 1 :minute 0 :second 2
:zone ict:est :dst nil))
(sub1 (list low1 high1))
(sub1 (icr:make-interval low1 high1))
(expected-recs
(list low1
(ical:date-time-variant low1 :second 59 :tz 'preserve)
@ -1534,7 +1554,7 @@ SOURCE should be a symbol; it is used to name the test."
(win-high
(or ,high
until
(cadr
(icr:interval-high
(icr:nth-interval 2 ,dtstart recvalue))))
(recs
(if count
@ -1741,6 +1761,7 @@ SOURCE should be a symbol; it is used to name the test."
(ict:rrule-test
"RRULE:FREQ=DAILY;INTERVAL=2\n"
"Every other day - forever"
:tags '(:expensive-test)
:tz ict:tz-eastern
:dtstart (ical:make-date-time :year 1997 :month 9 :day 2
:hour 9 :minute 0 :second 0
@ -2523,6 +2544,7 @@ SOURCE should be a symbol; it is used to name the test."
(ict:rrule-test
"RRULE:FREQ=YEARLY;BYDAY=TH;BYMONTH=6,7,8\n"
"Every Thursday, but only during June, July, and August, forever"
:tags '(:expensive-test)
:tz ict:tz-eastern
:dtstart (ical:make-date-time :year 1997 :month 6 :day 5
:hour 9 :minute 0 :second 0
@ -2576,6 +2598,7 @@ SOURCE should be a symbol; it is used to name the test."
(ict:rrule-test
"RRULE:FREQ=MONTHLY;BYDAY=FR;BYMONTHDAY=13\n"
"Every Friday the 13th, forever, *excluding* DTSTART "
:tags '(:expensive-test)
:tz ict:tz-eastern
:dtstart (ical:make-date-time :year 1997 :month 9 :day 2
:hour 9 :minute 0 :second 0
@ -2603,6 +2626,7 @@ SOURCE should be a symbol; it is used to name the test."
(ict:rrule-test
"RRULE:FREQ=MONTHLY;BYDAY=SA;BYMONTHDAY=7,8,9,10,11,12,13\n"
"The first Saturday that follows the first Sunday of the month, forever"
:tags '(:expensive-test)
:tz ict:tz-eastern
:dtstart (ical:make-date-time :year 1997 :month 9 :day 13
:hour 9 :minute 0 :second 0
@ -2654,6 +2678,7 @@ SOURCE should be a symbol; it is used to name the test."
"RRULE:FREQ=MONTHLY;COUNT=3;BYDAY=TU,WE,TH;BYSETPOS=3\n"
"The third instance into the month of one of Tuesday, Wednesday, or
Thursday, for the next 3 months"
:tags '(:expensive-test)
;; TODO: Yikes, why is this so slow??
:tz ict:tz-eastern
:dtstart (ical:make-date-time :year 1997 :month 9 :day 4
@ -2672,6 +2697,7 @@ Thursday, for the next 3 months"
(ict:rrule-test
"RRULE:FREQ=MONTHLY;BYDAY=MO,TU,WE,TH,FR;BYSETPOS=-2\n"
"The second-to-last weekday of the month"
:tags '(:expensive-test)
:tz ict:tz-eastern
:dtstart (ical:make-date-time :year 1997 :month 9 :day 29
:hour 9 :minute 0 :second 0
@ -2751,6 +2777,7 @@ Thursday, for the next 3 months"
(ict:rrule-test
"RRULE:FREQ=DAILY;BYHOUR=9,10,11,12,13,14,15,16;BYMINUTE=0,20,40\n"
"Every 20 minutes from 9:00 AM to 4:40 PM every day"
:tags '(:expensive-test)
:tz ict:tz-eastern
:dtstart (ical:make-date-time :year 1997 :month 9 :day 2
:hour 9 :minute 0 :second 0