giles
bf7bd38010
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m5s
timezone.sx: wall-clock LOCAL <-> absolute UTC. :fixed + :dst zones (std/dst offsets + UTC transition rules, EU-style, no IANA DB) computed via calendar helpers. ev-event-tz authors in local time; ev-expand expands tz events in LOCAL time then converts each occurrence to UTC, so a 09:00 weekly meeting stays 09:00 across a DST change (UTC instant shifts). Predefined utc/london/ paris. Plain events unaffected. 295/295 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
174 lines
5.0 KiB
Plaintext
174 lines
5.0 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)
|
|
(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})))
|