diff options
| -rw-r--r-- | lib/kernel/computus.ml | 7 | ||||
| -rw-r--r-- | lib/kernel/computus.mli | 10 | ||||
| -rw-r--r-- | test/test_computus.ml | 20 |
3 files changed, 36 insertions, 1 deletions
diff --git a/lib/kernel/computus.ml b/lib/kernel/computus.ml index 1f60fb7..ba803d2 100644 --- a/lib/kernel/computus.ml +++ b/lib/kernel/computus.ml @@ -18,6 +18,13 @@ let gregorian_easter y = let day = ((h + l - (7 * m) + 114) mod 31) + 1 in mk y month day +let anchor y offset = Date.add_days (gregorian_easter y) offset +let ash_wednesday y = anchor y (-46) +let palm_sunday y = anchor y (-7) +let ascension y = anchor y 39 +let pentecost y = anchor y 49 +let corpus_christi y = anchor y 60 + (* Meeus Julian Easter: gives the JULIAN-calendar month/day; convert to the same physical day expressed in the proleptic Gregorian calendar by adding the Julian->Gregorian offset (days = y/100 - y/400 - 2). *) diff --git a/lib/kernel/computus.mli b/lib/kernel/computus.mli index dc8f215..0e227dc 100644 --- a/lib/kernel/computus.mli +++ b/lib/kernel/computus.mli @@ -4,6 +4,16 @@ (** Easter Sunday by the Gregorian reckoning (OF + EF). *) val gregorian_easter : int -> Date.t +(** Easter-relative movable-feast anchors (register section 0), Gregorian + reckoning: Ash Wednesday = Easter-46 (Wed), Palm Sunday = Easter-7, + Ascension = Easter+39 (Thu), Pentecost = Easter+49, Corpus Christi = + Easter+60 (Thu, EF). *) +val ash_wednesday : int -> Date.t +val palm_sunday : int -> Date.t +val ascension : int -> Date.t +val pentecost : int -> Date.t +val corpus_christi : int -> Date.t + (** Easter Sunday by the Julian reckoning, returned as the equivalent proleptic Gregorian date (for future eastern rites; EF/OF use {!gregorian_easter}). *) val julian_easter : int -> Date.t diff --git a/test/test_computus.ml b/test/test_computus.ml index 1502ad2..cbb8cab 100644 --- a/test/test_computus.ml +++ b/test/test_computus.ml @@ -31,8 +31,26 @@ let test_gregorian_invariants_exhaustive () = Alcotest.(check bool) (Printf.sprintf "%d Easter in [Mar22,Apr25]" y) true ok done +let test_anchors_2026 () = + (* Easter 2026 = Apr 5 *) + Alcotest.(check (triple int int int)) "Ash Wednesday 2026" (2026, 2, 18) (ymd (C.ash_wednesday 2026)); + Alcotest.(check (triple int int int)) "Palm Sunday 2026" (2026, 3, 29) (ymd (C.palm_sunday 2026)); + Alcotest.(check (triple int int int)) "Ascension 2026" (2026, 5, 14) (ymd (C.ascension 2026)); + Alcotest.(check (triple int int int)) "Pentecost 2026" (2026, 5, 24) (ymd (C.pentecost 2026)) + +let test_anchor_weekdays_exhaustive () = + for y = 1583 to 9999 do + Alcotest.(check bool) (Printf.sprintf "%d Ash Wed = Wed" y) true (D.weekday (C.ash_wednesday y) = D.Wed); + Alcotest.(check bool) (Printf.sprintf "%d Palm Sun = Sun" y) true (D.weekday (C.palm_sunday y) = D.Sun); + Alcotest.(check bool) (Printf.sprintf "%d Ascension = Thu" y) true (D.weekday (C.ascension y) = D.Thu); + Alcotest.(check bool) (Printf.sprintf "%d Pentecost = Sun" y) true (D.weekday (C.pentecost y) = D.Sun); + Alcotest.(check bool) (Printf.sprintf "%d Corpus Christi = Thu" y) true (D.weekday (C.corpus_christi y) = D.Thu) + done + let suite = ( "Computus", [ Alcotest.test_case "Gregorian known dates" `Quick test_gregorian_known; Alcotest.test_case "Julian known dates" `Quick test_julian_known; - Alcotest.test_case "Gregorian invariants 1583..9999" `Slow test_gregorian_invariants_exhaustive ] ) + Alcotest.test_case "Gregorian invariants 1583..9999" `Slow test_gregorian_invariants_exhaustive; + Alcotest.test_case "anchors 2026" `Quick test_anchors_2026; + Alcotest.test_case "anchor weekdays 1583..9999" `Slow test_anchor_weekdays_exhaustive ] ) |