giles
6716af69dc
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
The previous commit asserted southern zones round-trip through iCal unchanged but verified it only by reasoning. Close that gap with explicit tests: - A Sydney VTIMEZONE export block: TZID:Australia/Sydney, DAYLIGHT->+1100 (AEDT) / STANDARD->+1000 (AEST), first-Sunday rules (BYMONTH=10/4 BYDAY=1SU), and DAYLIGHT DTSTART:19701004T020000 — confirming the -480 rule time folds the from-offset back to the correct local 02:00 AEST transition. - A southern-zone DTSTART;TZID export -> import round-trip preserving :dtstart. +7 ical tests (now 63). Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
405 lines
15 KiB
Plaintext
405 lines
15 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 (TZID + VTIMEZONE) ----
|
|
(define
|
|
ev-ic-find
|
|
(fn
|
|
(lines pfx)
|
|
(cond
|
|
((empty? lines) nil)
|
|
((ev-ic-prefix? (first lines) pfx) (first lines))
|
|
(else (ev-ic-find (rest lines) pfx)))))
|
|
|
|
(define ev-ic-count (fn (lines x) (len (filter (fn (l) (= l x)) lines))))
|
|
|
|
(define
|
|
ev-ic-index
|
|
(fn
|
|
(lines x)
|
|
(cond
|
|
((empty? lines) -1)
|
|
((= (first lines) x) 0)
|
|
(else
|
|
(let ((r (ev-ic-index (rest lines) x))) (if (< r 0) -1 (+ 1 r)))))))
|
|
|
|
(define
|
|
ev-ic-tz-run-all!
|
|
(fn
|
|
()
|
|
(do
|
|
;; a tz event's DTSTART is local wall-clock with a TZID parameter
|
|
(ev-ic-check!
|
|
"tz event DTSTART uses TZID + local wall-clock (not UTC)"
|
|
(ev-ic-find (ev/event->ical-lines (ev-event-tz (quote w) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-london)) "DTSTART")
|
|
"DTSTART;TZID=Europe/London:20260715T180000")
|
|
(ev-ic-check!
|
|
"a non-tz event still uses a UTC Z stamp"
|
|
(ev-ic-find (ev/event->ical-lines (ev-event (quote n) (ev-dt 2026 7 15 18 0) 60 nil 1)) "DTSTART")
|
|
"DTSTART:20260715T180000Z")
|
|
;; UNTIL stays UTC even for a TZID event (RFC 5545)
|
|
(ev-ic-check!
|
|
"tz event RRULE UNTIL is still UTC"
|
|
(ev-ic-find
|
|
(ev/event->ical-lines
|
|
(ev-event-tz (quote s) (ev-dt 2026 6 1 18 0) 60 {:freq :weekly :byday (list 0) :until (ev-dt 2026 6 30 23 0)} 1 ev-tz-london))
|
|
"RRULE")
|
|
"RRULE:FREQ=WEEKLY;UNTIL=20260630T220000Z;BYDAY=MO")
|
|
;; EXDATE matches the DTSTART form (TZID + local)
|
|
(ev-ic-check!
|
|
"tz event EXDATE uses TZID + local"
|
|
(ev-ic-find
|
|
(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;TZID=Europe/London:20260702T180000")
|
|
|
|
;; ---- VTIMEZONE block ----
|
|
(let
|
|
((vtz (ev-ical-vtimezone ev-tz-london)))
|
|
(do
|
|
(ev-ic-check! "VTIMEZONE names the zone" (ev-ic-find vtz "TZID") "TZID:Europe/London")
|
|
(ev-ic-check! "DAYLIGHT transitions GMT->BST" (ev-ic-find vtz "TZOFFSETTO:+0100") "TZOFFSETTO:+0100")
|
|
(ev-ic-check! "DAYLIGHT rule is last Sunday of March" (ev-ic-find vtz "RRULE:FREQ=YEARLY;BYMONTH=3") "RRULE:FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU")
|
|
(ev-ic-check! "STANDARD rule is last Sunday of October" (ev-ic-find vtz "RRULE:FREQ=YEARLY;BYMONTH=10") "RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=-1SU")))
|
|
(let
|
|
((vtz (ev-ical-vtimezone ev-tz-paris)))
|
|
(do
|
|
(ev-ic-check! "Paris DAYLIGHT goes to +0200 (CEST)" (ev-ic-find vtz "TZOFFSETTO:+0200") "TZOFFSETTO:+0200")
|
|
(ev-ic-check! "Paris STANDARD goes to +0100 (CET)" (ev-ic-find vtz "TZOFFSETTO:+0100") "TZOFFSETTO:+0100")))
|
|
;; southern hemisphere exports a valid VTIMEZONE too: reversed offsets,
|
|
;; first-Sunday rules, and the -480 rule time folds back to local 02:00/03:00
|
|
(let
|
|
((vtz (ev-ical-vtimezone ev-tz-sydney)))
|
|
(do
|
|
(ev-ic-check! "Sydney VTIMEZONE names the zone" (ev-ic-find vtz "TZID") "TZID:Australia/Sydney")
|
|
(ev-ic-check! "Sydney DAYLIGHT goes to +1100 (AEDT)" (ev-ic-find vtz "TZOFFSETTO:+1100") "TZOFFSETTO:+1100")
|
|
(ev-ic-check! "Sydney STANDARD goes to +1000 (AEST)" (ev-ic-find vtz "TZOFFSETTO:+1000") "TZOFFSETTO:+1000")
|
|
(ev-ic-check! "Sydney DAYLIGHT rule is first Sunday of October" (ev-ic-find vtz "RRULE:FREQ=YEARLY;BYMONTH=10") "RRULE:FREQ=YEARLY;BYMONTH=10;BYDAY=1SU")
|
|
(ev-ic-check! "Sydney STANDARD rule is first Sunday of April" (ev-ic-find vtz "RRULE:FREQ=YEARLY;BYMONTH=4") "RRULE:FREQ=YEARLY;BYMONTH=4;BYDAY=1SU")
|
|
(ev-ic-check! "Sydney DAYLIGHT begins 02:00 local (AEST std, -480 folded)" (ev-ic-find vtz "DTSTART") "DTSTART:19701004T020000")))
|
|
|
|
;; ---- VCALENDAR carries one VTIMEZONE per distinct zone ----
|
|
(let
|
|
((cal (ev/events->ical-lines (list (ev-event-tz (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1 ev-tz-london)))))
|
|
(do
|
|
(ev-ic-check! "VCALENDAR includes the referenced VTIMEZONE" (ev-ic-count cal "BEGIN:VTIMEZONE") 1)
|
|
(ev-ic-check! "VTIMEZONE precedes the VEVENT" (< (ev-ic-index cal "BEGIN:VTIMEZONE") (ev-ic-index cal "BEGIN:VEVENT")) true)))
|
|
(ev-ic-check!
|
|
"two events in the same zone share one VTIMEZONE"
|
|
(ev-ic-count
|
|
(ev/events->ical-lines
|
|
(list
|
|
(ev-event-tz (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1 ev-tz-london)
|
|
(ev-event-tz (quote b) (ev-dt 2026 6 2 9 0) 60 nil 1 ev-tz-london)))
|
|
"BEGIN:VTIMEZONE")
|
|
1)
|
|
(ev-ic-check!
|
|
"events in two zones get two VTIMEZONEs"
|
|
(ev-ic-count
|
|
(ev/events->ical-lines
|
|
(list
|
|
(ev-event-tz (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1 ev-tz-london)
|
|
(ev-event-tz (quote b) (ev-dt 2026 6 2 9 0) 60 nil 1 ev-tz-paris)))
|
|
"BEGIN:VTIMEZONE")
|
|
2)
|
|
(ev-ic-check!
|
|
"a non-tz-only calendar has no VTIMEZONE"
|
|
(ev-ic-count (ev/events->ical-lines (list (ev-event (quote a) (ev-dt 2026 6 1 9 0) 60 nil 1))) "BEGIN:VTIMEZONE")
|
|
0)
|
|
|
|
;; ---- import tolerates the TZID parameter ----
|
|
(ev-ic-check!
|
|
"import parses DTSTART;TZID local time"
|
|
(get
|
|
(ev/ical-lines->event (ev/event->ical-lines (ev-event-tz (quote a) (ev-dt 2026 7 15 18 0) 60 nil 1 ev-tz-london)))
|
|
:dtstart)
|
|
(ev-dt 2026 7 15 18 0))
|
|
(ev-ic-check!
|
|
"import parses a southern-zone DTSTART;TZID local time"
|
|
(get
|
|
(ev/ical-lines->event (ev/event->ical-lines (ev-event-tz (quote a) (ev-dt 2026 1 15 18 0) 60 nil 1 ev-tz-sydney)))
|
|
:dtstart)
|
|
(ev-dt 2026 1 15 18 0)))))
|
|
|
|
(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})))
|