giles
34c9b211ac
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
Bug: tz events store wall-clock LOCAL times but export stamped them with a Z (UTC) suffix, so a London 18:00 event falsely read as 18:00 UTC. ev-ical-conv now converts a tz event's DTSTART/UNTIL/EXDATE/RDATE local->UTC before formatting (London summer 18:00 -> 170000Z; Paris -> 160000Z); non-tz events unchanged. Caveat: UTC RRULE drifts from wall-clock-stable tz recurrence across a DST boundary (VTIMEZONE deferred). 366/366 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
323 lines
11 KiB
Plaintext
323 lines
11 KiB
Plaintext
;; lib/events/tests/ical.sx — iCalendar (RFC 5545) export.
|
|
|
|
(define ev-ic-pass 0)
|
|
(define ev-ic-fail 0)
|
|
(define ev-ic-failures (list))
|
|
|
|
(define
|
|
ev-ic-check!
|
|
(fn
|
|
(name got expected)
|
|
(if
|
|
(= got expected)
|
|
(set! ev-ic-pass (+ ev-ic-pass 1))
|
|
(do
|
|
(set! ev-ic-fail (+ ev-ic-fail 1))
|
|
(append!
|
|
ev-ic-failures
|
|
(str name "\n expected: " expected "\n got: " got))))))
|
|
|
|
;; Find the value of a "KEY:value" line in a VEVENT line list (or nil).
|
|
(define
|
|
ev-ic-line
|
|
(fn
|
|
(lines key)
|
|
(cond
|
|
((empty? lines) nil)
|
|
((ev-ic-prefix? (first lines) (str key ":")) (first lines))
|
|
(else (ev-ic-line (rest lines) key)))))
|
|
|
|
(define
|
|
ev-ic-prefix?
|
|
(fn
|
|
(s p)
|
|
(and (>= (len s) (len p)) (= (substring s 0 (len p)) p))))
|
|
|
|
(define
|
|
ev-ic-run-all!
|
|
(fn
|
|
()
|
|
(do
|
|
(let
|
|
((lines (ev/event->ical-lines (ev-event (quote one) (ev-dt 2026 6 10 14 0) 60 nil 1))))
|
|
(do
|
|
(ev-ic-check! "VEVENT opens" (first lines) "BEGIN:VEVENT")
|
|
(ev-ic-check! "VEVENT closes" (ev-ic-line lines "END") "END:VEVENT")
|
|
(ev-ic-check!
|
|
"UID is the event id"
|
|
(ev-ic-line lines "UID")
|
|
"UID:one")
|
|
(ev-ic-check!
|
|
"DTSTART is a UTC basic-format stamp"
|
|
(ev-ic-line lines "DTSTART")
|
|
"DTSTART:20260610T140000Z")
|
|
(ev-ic-check!
|
|
"DURATION of 60m is PT1H"
|
|
(ev-ic-line lines "DURATION")
|
|
"DURATION:PT1H")
|
|
(ev-ic-check!
|
|
"a one-off event has no RRULE"
|
|
(ev-ic-line lines "RRULE")
|
|
nil)))
|
|
(ev-ic-check!
|
|
"30m duration is PT30M"
|
|
(ev-ic-line
|
|
(ev/event->ical-lines
|
|
(ev-event
|
|
(quote e)
|
|
(ev-dt 2026 1 1 9 0)
|
|
30
|
|
nil
|
|
1))
|
|
"DURATION")
|
|
"DURATION:PT30M")
|
|
(ev-ic-check!
|
|
"90m duration is PT1H30M"
|
|
(ev-ic-line
|
|
(ev/event->ical-lines
|
|
(ev-event
|
|
(quote e)
|
|
(ev-dt 2026 1 1 9 0)
|
|
90
|
|
nil
|
|
1))
|
|
"DURATION")
|
|
"DURATION:PT1H30M")
|
|
(let
|
|
((lines (ev/event->ical-lines (ev-event-full (quote yoga) (ev-dt 2026 6 1 18 0) 90 {:interval 2 :freq :weekly :until (ev-dt 2026 6 30 23 0) :byday (list 0 2)} 20 (list (ev-dt 2026 6 8 18 0)) (list (ev-dt 2026 6 20 18 0))))))
|
|
(do
|
|
(ev-ic-check!
|
|
"weekly RRULE serializes interval/until/byday in order"
|
|
(ev-ic-line lines "RRULE")
|
|
"RRULE:FREQ=WEEKLY;INTERVAL=2;UNTIL=20260630T230000Z;BYDAY=MO,WE")
|
|
(ev-ic-check!
|
|
"EXDATE line"
|
|
(ev-ic-line lines "EXDATE")
|
|
"EXDATE:20260608T180000Z")
|
|
(ev-ic-check!
|
|
"RDATE line"
|
|
(ev-ic-line lines "RDATE")
|
|
"RDATE:20260620T180000Z")))
|
|
(ev-ic-check!
|
|
"daily COUNT RRULE"
|
|
(ev-ic-line
|
|
(ev/event->ical-lines
|
|
(ev-event
|
|
(quote d)
|
|
(ev-dt 2026 6 1 9 0)
|
|
30
|
|
{:freq :daily :count 5}
|
|
1))
|
|
"RRULE")
|
|
"RRULE:FREQ=DAILY;COUNT=5")
|
|
(ev-ic-check!
|
|
"monthly nth-weekday BYDAY (2nd Tuesday)"
|
|
(ev-ic-line
|
|
(ev/event->ical-lines
|
|
(ev-event
|
|
(quote b)
|
|
(ev-dt 2026 1 13 9 0)
|
|
60
|
|
{:freq :monthly :byday (list {:ord 2 :wd 1})}
|
|
5))
|
|
"RRULE")
|
|
"RRULE:FREQ=MONTHLY;BYDAY=2TU")
|
|
(ev-ic-check!
|
|
"monthly last-Friday BYDAY"
|
|
(ev-ic-line
|
|
(ev/event->ical-lines
|
|
(ev-event
|
|
(quote b)
|
|
(ev-dt 2026 1 30 9 0)
|
|
60
|
|
{:freq :monthly :byday (list {:ord -1 :wd 4})}
|
|
5))
|
|
"RRULE")
|
|
"RRULE:FREQ=MONTHLY;BYDAY=-1FR")
|
|
(ev-ic-check!
|
|
"monthly BYMONTHDAY (incl. negative)"
|
|
(ev-ic-line
|
|
(ev/event->ical-lines
|
|
(ev-event
|
|
(quote b)
|
|
(ev-dt 2026 1 15 9 0)
|
|
60
|
|
{:bymonthday (list 15 -1) :freq :monthly}
|
|
5))
|
|
"RRULE")
|
|
"RRULE:FREQ=MONTHLY;BYMONTHDAY=15,-1")
|
|
(ev-ic-check!
|
|
"all seven weekday tokens map correctly"
|
|
(ev-ic-line
|
|
(ev/event->ical-lines
|
|
(ev-event
|
|
(quote w)
|
|
(ev-dt 2026 6 1 9 0)
|
|
30
|
|
{:freq :weekly :byday (list 0 1 2 3 4 5 6)}
|
|
1))
|
|
"RRULE")
|
|
"RRULE:FREQ=WEEKLY;BYDAY=MO,TU,WE,TH,FR,SA,SU")
|
|
(let
|
|
((cal (ev/events->ical-lines (list (ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 nil 1) (ev-event (quote b) (ev-dt 2026 6 2 9 0) 30 nil 1)))))
|
|
(do
|
|
(ev-ic-check! "VCALENDAR opens" (first cal) "BEGIN:VCALENDAR")
|
|
(ev-ic-check!
|
|
"VCALENDAR declares VERSION"
|
|
(ev-ic-line cal "VERSION")
|
|
"VERSION:2.0")
|
|
(ev-ic-check!
|
|
"two events -> two VEVENT blocks"
|
|
(len (filter (fn (l) (= l "BEGIN:VEVENT")) cal))
|
|
2)
|
|
(ev-ic-check!
|
|
"VCALENDAR has exactly one closing line"
|
|
(len (filter (fn (l) (= l "END:VCALENDAR")) cal))
|
|
1)))
|
|
(ev-ic-check!
|
|
"render joins lines with CRLF"
|
|
(ev/ical-render
|
|
(list "BEGIN:VCALENDAR" "VERSION:2.0" "END:VCALENDAR"))
|
|
"BEGIN:VCALENDAR\r\nVERSION:2.0\r\nEND:VCALENDAR"))))
|
|
|
|
;; ---- import + round-trip ----
|
|
|
|
;; The occurrence starts an event expands to over a fixed window.
|
|
(define
|
|
ev-ic-starts
|
|
(fn
|
|
(ev)
|
|
(map (fn (o) (get o :start)) (ev-expand ev (ev-date 2026 1 1) (ev-date 2027 1 1)))))
|
|
|
|
;; Round-trip an event through export then import; true if both expand alike.
|
|
(define
|
|
ev-ic-roundtrips?
|
|
(fn
|
|
(ev)
|
|
(= (ev-ic-starts ev) (ev-ic-starts (ev/ical-lines->event (ev/event->ical-lines ev))))))
|
|
|
|
(define
|
|
ev-ic-rt-run-all!
|
|
(fn
|
|
()
|
|
(do
|
|
;; ---- field parsers ----
|
|
(ev-ic-check! "parse DTSTART" (ev-ical-parse-dt "20260601T180000Z") (ev-dt 2026 6 1 18 0))
|
|
(ev-ic-check! "parse DURATION PT1H30M" (ev-ical-parse-duration "PT1H30M") 90)
|
|
(ev-ic-check! "parse DURATION PT1H" (ev-ical-parse-duration "PT1H") 60)
|
|
(ev-ic-check! "parse DURATION PT30M" (ev-ical-parse-duration "PT30M") 30)
|
|
(ev-ic-check! "parse plain BYDAY token" (ev-ical-parse-byday-token "MO") 0)
|
|
(ev-ic-check! "parse ordinal BYDAY token" (ev-ical-parse-byday-token "2TU") {:ord 2 :wd 1})
|
|
(ev-ic-check! "parse last-weekday BYDAY token" (ev-ical-parse-byday-token "-1FR") {:ord -1 :wd 4})
|
|
|
|
;; ---- imported event basic fields ----
|
|
(let
|
|
((ev (ev/ical-lines->event (ev/event->ical-lines (ev-event (quote yoga) (ev-dt 2026 6 1 18 0) 90 nil 1)))))
|
|
(do
|
|
(ev-ic-check! "imported id is a symbol" (get ev :id) (quote yoga))
|
|
(ev-ic-check! "imported dtstart" (get ev :dtstart) (ev-dt 2026 6 1 18 0))
|
|
(ev-ic-check! "imported duration" (get ev :duration) 90)))
|
|
|
|
;; ---- round-trips preserve the occurrence set ----
|
|
(ev-ic-check!
|
|
"round-trip: one-off event"
|
|
(ev-ic-roundtrips? (ev-event (quote a) (ev-dt 2026 6 10 14 0) 60 nil 1))
|
|
true)
|
|
(ev-ic-check!
|
|
"round-trip: daily COUNT"
|
|
(ev-ic-roundtrips? (ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 5} 1))
|
|
true)
|
|
(ev-ic-check!
|
|
"round-trip: weekly interval/until/byday + exdate + rdate"
|
|
(ev-ic-roundtrips?
|
|
(ev-event-full
|
|
(quote a)
|
|
(ev-dt 2026 6 1 18 0)
|
|
90
|
|
{:freq :weekly :interval 2 :byday (list 0 2) :until (ev-dt 2026 6 30 23 0)}
|
|
20
|
|
(list (ev-dt 2026 6 8 18 0))
|
|
(list (ev-dt 2026 6 20 18 0))))
|
|
true)
|
|
(ev-ic-check!
|
|
"round-trip: monthly nth-weekday"
|
|
(ev-ic-roundtrips? (ev-event (quote a) (ev-dt 2026 1 13 9 0) 60 {:freq :monthly :byday (list {:ord 2 :wd 1})} 1))
|
|
true)
|
|
(ev-ic-check!
|
|
"round-trip: monthly bymonthday"
|
|
(ev-ic-roundtrips? (ev-event (quote a) (ev-dt 2026 1 15 9 0) 60 {:freq :monthly :bymonthday (list 15 -1)} 1))
|
|
true)
|
|
|
|
;; ---- parse a VCALENDAR with several events ----
|
|
(let
|
|
((cal
|
|
(ev/events->ical-lines
|
|
(list
|
|
(ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 3} 1)
|
|
(ev-event (quote b) (ev-dt 2026 6 2 10 0) 60 nil 1)))))
|
|
(let
|
|
((events (ev/parse-vcalendar cal)))
|
|
(do
|
|
(ev-ic-check! "VCALENDAR parses both events" (len events) 2)
|
|
(ev-ic-check! "first event id" (get (first events) :id) (quote a))
|
|
(ev-ic-check! "second event id" (get (first (rest events)) :id) (quote b))
|
|
(ev-ic-check!
|
|
"parsed events expand correctly"
|
|
(ev-ic-starts (first events))
|
|
(ev-ic-starts (ev-event (quote a) (ev-dt 2026 6 1 9 0) 30 {:freq :daily :count 3} 1)))))))))
|
|
|
|
;; ---- timezone-aware export (local wall-clock -> UTC stamps) ----
|
|
(define
|
|
ev-ic-dtstart
|
|
(fn (ev) (ev-ic-line (ev/event->ical-lines ev) "DTSTART")))
|
|
|
|
(define
|
|
ev-ic-tz-run-all!
|
|
(fn
|
|
()
|
|
(do
|
|
(ev-ic-check!
|
|
"London winter event exports as the same UTC (GMT)"
|
|
(ev-ic-dtstart (ev-event-tz (quote w) (ev-dt 2026 1 15 18 0) 60 nil 1 ev-tz-london))
|
|
"DTSTART:20260115T180000Z")
|
|
(ev-ic-check!
|
|
"London summer event exports one hour earlier in UTC (BST)"
|
|
(ev-ic-dtstart (ev-event-tz (quote s) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-london))
|
|
"DTSTART:20260715T170000Z")
|
|
(ev-ic-check!
|
|
"Paris winter (CET +1) exports one hour earlier in UTC"
|
|
(ev-ic-dtstart (ev-event-tz (quote p) (ev-dt 2026 1 15 18 0) 60 nil 1 ev-tz-paris))
|
|
"DTSTART:20260115T170000Z")
|
|
(ev-ic-check!
|
|
"Paris summer (CEST +2) exports two hours earlier in UTC"
|
|
(ev-ic-dtstart (ev-event-tz (quote p) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-paris))
|
|
"DTSTART:20260715T160000Z")
|
|
(ev-ic-check!
|
|
"a non-tz event is exported unchanged"
|
|
(ev-ic-dtstart (ev-event (quote n) (ev-dt 2026 7 15 18 0) 60 nil 1))
|
|
"DTSTART:20260715T180000Z")
|
|
;; EXDATE on a tz event is also converted to UTC
|
|
(ev-ic-check!
|
|
"tz event EXDATE is converted to UTC"
|
|
(ev-ic-line
|
|
(ev/event->ical-lines
|
|
(assoc
|
|
(ev-event-tz (quote s) (ev-dt 2026 7 1 18 0) 60 {:freq :daily :count 3} 1 ev-tz-london)
|
|
:exdate
|
|
(list (ev-dt 2026 7 2 18 0))))
|
|
"EXDATE")
|
|
"EXDATE:20260702T170000Z"))))
|
|
|
|
(define
|
|
ev-ical-tests-run!
|
|
(fn
|
|
()
|
|
(do
|
|
(set! ev-ic-pass 0)
|
|
(set! ev-ic-fail 0)
|
|
(set! ev-ic-failures (list))
|
|
(ev-ic-run-all!)
|
|
(ev-ic-rt-run-all!)
|
|
(ev-ic-tz-run-all!)
|
|
{:failures ev-ic-failures :total (+ ev-ic-pass ev-ic-fail) :passed ev-ic-pass :failed ev-ic-fail})))
|