Files
rose-ash/lib/events/tests/timezone.sx
giles 78b45a331e
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
events: southern-hemisphere DST (+8) — 384/384
The :dst zone model assumed northern ordering (dst-start < dst-end, DST =
[start, end)). Southern zones — DST begins ~Oct and ends ~Apr — have
dst-start > dst-end, so the old (>= start AND < end) test was never true and
ev-tz-offset returned the standard offset year-round.

Fix: detect the ordering. start < end → DST is [start, end); start > end →
DST wraps the calendar-year boundary, active when (utc >= start OR utc < end).

Add predefined ev-tz-sydney (AEST +600 / AEDT +660; transitions 02:00 AEST
first-Sun-Oct and 03:00 AEDT first-Sun-Apr, both 16:00 UTC the preceding
Saturday → rule time -480). VTIMEZONE export is already rule-agnostic, so
southern zones round-trip through iCal unchanged (the -480 folds the
from-offset back to the correct local 02:00/03:00 DTSTART).

+8 timezone tests (now 25): summer/winter offsets, both transition dates,
local->utc in both seasons, and a daily expansion crossing the autumn DST-end
that shifts in UTC (1320,1320,1380,1380,1380) while staying 09:00 local.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-10 20:59:59 +00:00

226 lines
6.9 KiB
Plaintext

;; lib/events/tests/timezone.sx — timezones + DST.
(define ev-tz-pass 0)
(define ev-tz-fail 0)
(define ev-tz-failures (list))
(define
ev-tz-check!
(fn
(name got expected)
(if
(= got expected)
(set! ev-tz-pass (+ ev-tz-pass 1))
(do
(set! ev-tz-fail (+ ev-tz-fail 1))
(append!
ev-tz-failures
(str name "\n expected: " expected "\n got: " got))))))
;; Wall-clock (civil + minute-of-day) an occurrence's UTC start maps to in a tz.
(define
ev-tz-local-of
(fn
(tz utc-dt)
(let
((l (ev-tz-utc->local tz utc-dt)))
(list (ev-dt->civil l) (ev-dt-tod l)))))
(define
ev-tz-run-all!
(fn
()
(do
(let
((nyc (ev-tz-fixed "EST" -300)))
(do
(ev-tz-check!
"fixed zone: utc -> local subtracts 5h"
(ev-tz-utc->local
nyc
(ev-dt 2026 1 1 17 0))
(ev-dt 2026 1 1 12 0))
(ev-tz-check!
"fixed zone: local -> utc adds 5h back"
(ev-tz-local->utc
nyc
(ev-dt 2026 1 1 12 0))
(ev-dt 2026 1 1 17 0))
(ev-tz-check!
"UTC zone is identity"
(ev-tz-local->utc
ev-tz-utc
(ev-dt 2026 6 1 9 0))
(ev-dt 2026 6 1 9 0))))
(ev-tz-check!
"London winter offset is 0 (GMT)"
(ev-tz-offset
ev-tz-london
(ev-dt 2026 1 15 12 0))
0)
(ev-tz-check!
"London summer offset is 60 (BST)"
(ev-tz-offset
ev-tz-london
(ev-dt 2026 7 15 12 0))
60)
(ev-tz-check!
"Paris winter offset is 60 (CET)"
(ev-tz-offset
ev-tz-paris
(ev-dt 2026 1 15 12 0))
60)
(ev-tz-check!
"Paris summer offset is 120 (CEST)"
(ev-tz-offset
ev-tz-paris
(ev-dt 2026 7 15 12 0))
120)
;; ---- southern hemisphere (reversed seasons) ----
(ev-tz-check!
"Sydney January offset is 660 (AEDT, summer DST)"
(ev-tz-offset
ev-tz-sydney
(ev-dt 2026 1 15 12 0))
660)
(ev-tz-check!
"Sydney July offset is 600 (AEST, winter std)"
(ev-tz-offset
ev-tz-sydney
(ev-dt 2026 7 15 12 0))
600)
(ev-tz-check!
"Sydney DST starts first Sunday of October"
(ev-dt->civil
(+ (ev-tz-transition 2026 (get ev-tz-sydney :dst-start)) 480))
(list 2026 10 4))
(ev-tz-check!
"Sydney DST ends first Sunday of April"
(ev-dt->civil
(+ (ev-tz-transition 2026 (get ev-tz-sydney :dst-end)) 480))
(list 2026 4 5))
(ev-tz-check!
"09:00 Sydney in summer (AEDT) is previous-day 22:00 UTC"
(ev-tz-local->utc
ev-tz-sydney
(ev-dt 2026 1 15 9 0))
(ev-dt 2026 1 14 22 0))
(ev-tz-check!
"09:00 Sydney in winter (AEST) is previous-day 23:00 UTC"
(ev-tz-local->utc
ev-tz-sydney
(ev-dt 2026 7 15 9 0))
(ev-dt 2026 7 14 23 0))
(let
((au (ev-event-tz (quote au) (ev-dt 2026 4 3 9 0) 60 {:freq :daily :count 5} 8 ev-tz-sydney)))
(let
((occs (ev-expand au (ev-date 2026 3 25) (ev-date 2026 4 12))))
(do
(ev-tz-check!
"Sydney daily occurrences shift in UTC across the autumn DST end"
(map (fn (o) (ev-dt-tod (get o :start))) occs)
(list 1320 1320 1380 1380 1380))
(ev-tz-check!
"but every Sydney occurrence stays 09:00 local wall-clock"
(map
(fn
(o)
(first (rest (ev-tz-local-of ev-tz-sydney (get o :start)))))
occs)
(list 540 540 540 540 540)))))
(ev-tz-check!
"DST starts last Sunday of March"
(ev-dt->civil
(ev-tz-transition
2026
(ev-tz-rule 3 -1 6 60)))
(list 2026 3 29))
(ev-tz-check!
"DST ends last Sunday of October"
(ev-dt->civil
(ev-tz-transition
2026
(ev-tz-rule 10 -1 6 60)))
(list 2026 10 25))
(ev-tz-check!
"09:00 London in winter is 09:00 UTC"
(ev-tz-local->utc
ev-tz-london
(ev-dt 2026 1 15 9 0))
(ev-dt 2026 1 15 9 0))
(ev-tz-check!
"09:00 London in summer is 08:00 UTC"
(ev-tz-local->utc
ev-tz-london
(ev-dt 2026 7 15 9 0))
(ev-dt 2026 7 15 8 0))
(ev-tz-check!
"round trip utc -> local -> utc"
(ev-tz-local->utc
ev-tz-london
(ev-tz-utc->local
ev-tz-london
(ev-dt 2026 7 15 8 0)))
(ev-dt 2026 7 15 8 0))
(let
((ev (ev-event-tz (quote standup) (ev-dt 2026 3 27 9 0) 60 {:freq :daily :count 5} 10 ev-tz-london)))
(let
((occs (ev-expand ev (ev-date 2026 3 1) (ev-date 2026 4 5))))
(do
(ev-tz-check!
"daily occurrences shift in UTC across the DST boundary"
(map (fn (o) (ev-dt-tod (get o :start))) occs)
(list 540 540 480 480 480))
(ev-tz-check!
"but every occurrence stays 09:00 local wall-clock"
(map
(fn
(o)
(first
(rest (ev-tz-local-of ev-tz-london (get o :start)))))
occs)
(list 540 540 540 540 540))
(ev-tz-check!
"occurrence dates are stable in local time"
(map
(fn
(o)
(ev-civ-d
(first (ev-tz-local-of ev-tz-london (get o :start)))))
occs)
(list 27 28 29 30 31)))))
(let
((wk (ev-event-tz (quote class) (ev-dt 2026 3 23 18 0) 90 {:freq :weekly :byday (list 0)} 5 ev-tz-london)))
(let
((occs (ev-expand wk (ev-date 2026 3 1) (ev-date 2026 4 20))))
(ev-tz-check!
"weekly Monday 18:00 London stays 18:00 local each week"
(map
(fn
(o)
(first (rest (ev-tz-local-of ev-tz-london (get o :start)))))
occs)
(list 1080 1080 1080 1080))))
(let
((plain (ev-event (quote p) (ev-dt 2026 3 27 9 0) 60 {:freq :daily :count 3} 1)))
(ev-tz-check!
"plain event expands naively (no UTC shift)"
(map
(fn (o) (ev-dt-tod (get o :start)))
(ev-expand
plain
(ev-date 2026 3 1)
(ev-date 2026 4 5)))
(list 540 540 540))))))
(define
ev-timezone-tests-run!
(fn
()
(do
(set! ev-tz-pass 0)
(set! ev-tz-fail 0)
(set! ev-tz-failures (list))
(ev-tz-run-all!)
{:failures ev-tz-failures :total (+ ev-tz-pass ev-tz-fail) :passed ev-tz-pass :failed ev-tz-fail})))