diff options
| -rw-r--r-- | CLAUDE.md | 20 | ||||
| -rw-r--r-- | data/ef/adjustments.sexp | 50 | ||||
| -rw-r--r-- | lib/kernel/calendar.ml | 22 | ||||
| -rw-r--r-- | lib/kernel/date_spec.ml | 120 | ||||
| -rw-r--r-- | lib/kernel/date_spec.mli | 46 | ||||
| -rw-r--r-- | lib/kernel/layer.ml | 65 | ||||
| -rw-r--r-- | lib/kernel/layer.mli | 25 | ||||
| -rw-r--r-- | lib/kernel/rite.ml | 1 | ||||
| -rw-r--r-- | lib/kernel/rite.mli | 7 | ||||
| -rw-r--r-- | lib/kernel/validate.ml | 11 | ||||
| -rw-r--r-- | lib/rites/rite_ef/rite_ef.ml | 5 | ||||
| -rw-r--r-- | test/test_calendar.ml | 5 | ||||
| -rw-r--r-- | test/test_golden.ml | 40 | ||||
| -rw-r--r-- | test/test_names.ml | 137 | ||||
| -rw-r--r-- | test/test_overlay.ml | 13 | ||||
| -rw-r--r-- | test/test_rite_ef.ml | 2 | ||||
| -rw-r--r-- | test/test_sanctoral_ef.ml | 2 | ||||
| -rw-r--r-- | test/test_validate.ml | 5 |
18 files changed, 514 insertions, 62 deletions
@@ -61,6 +61,18 @@ tool, not part of lectio. Rite-agnostic **kernel** + **rite modules** (plug in via a signature) + **data overlays**. +- **`Date_spec` carries MOVABLE dates** (2026-08-17): `Fixed(month,day)` as + before, plus `Easter_offset of int` and `Nth_weekday of {month; nth; + weekday}` (negative `nth` counts from the end). `Fixed`'s sexp form is + unchanged, so all 327 sanctoral entries parse untouched. Easter comes from + the RITE (`Rite.t`'s `easter` field) — the kernel ships both Gregorian and + Julian and must not pick. `Layer` keeps a **split index**: fixed entries in + the year-independent `(month,day)` table, movable ones resolved per civil + year into a rata-die table, with the domain filter in `Layer.index` itself + (both edges, 1582 and 10000, bit during development). This unblocked + **Rogation Wednesday** (RG 87/88/89, register §6.10) and is what a + user-supplied overlay needs for a local movable feast. The `--overlay` CLI + plumbing is **not yet built**. - **Kernel** (`lib/kernel`, pure, total, bounded 1583–9999): `Computus` (Gregorian + Julian Easter + anchors), `Date` (proleptic Gregorian arithmetic), `Overlay` (ordered layer-merge algebra: field-level add/suppress/replace/edit, last-writer- @@ -242,8 +254,8 @@ against missalemeum; layer 5 pins ~30 dates. **Plans 1 + 2 are on `main` (35 commits). Plan 3 and its follow-on fix/feature tasks (RG 16(a), Holy Family/RG 112(a), Holy Name/RG 110, the Sacred Triduum, the BVM Saturday Office, the Major Litanies) have landed on a chain of feature -branches since — test count keeps climbing task by task (374 tests green, 375 -with the exhaustive sweep, as of `ef-oracle-2038`; this line is not kept in +branches since — test count keeps climbing task by task (388 tests green, 389 +with the exhaustive sweep, as of the movable-date-specs task; this line is not kept in lockstep with every task, `git log`/`dune test` are the actual source of truth).** The kernel, the **complete EF temporal cycle**, the **resolution engine**, the **sanctoral data**, and **all five @@ -291,7 +303,9 @@ M20 added by the `ef-major-litanies` task, M18 394 not 395 accordingly). Fixtures live in `test/fixtures/` with asserted SHA-256s. **CLI**: `colitur easter <year>`, `temporal <year>`, `day <year>`, -`readings <year>`, `-h`/`--help`. Man page in `man/colitur.1`. +`readings <year>`, `-h`/`--help`, `-V`/`--version`. Man page in +`man/colitur.1`; `Makefile` installs binary + data + man page into `~/.local` +by default. Tagged **v0.1.0**. `--help` prints to **stdout** and exits **0**; a usage error prints one line to **stderr** and exits **2**. The distinction is asserted in `test/cli.t`, diff --git a/data/ef/adjustments.sexp b/data/ef/adjustments.sexp index f41d0d1..790665b 100644 --- a/data/ef/adjustments.sexp +++ b/data/ef/adjustments.sexp @@ -257,6 +257,49 @@ ; rewrite (bucket recomputation) and .superpowers/sdd/2026-08-12-colitur- ; rg16a/sanctoral-audit-report.md. Two shapes of finding follow. ; +; `Add rogation-wednesday` -- NEW (movable-date-specs task, 2026-08-17). +; RG 87, primary-verified: "Litaniae minores seu Rogationes, per se, +; assignantur feriis II, III et IV ante festum Ascensionis Domini" +; (scan1.txt:691) -- Monday, Tuesday AND WEDNESDAY. colitur's temporal cycle +; already builds `ef-rogation-{monday,tuesday}` (Easter+36/+37) but never +; Wednesday: Easter+38 is by construction the Ascension Vigil (RG 91 entry +; 21), which wins the day structurally, so `Temporal_ef.named` emits the +; Vigil and there was no channel for the Rogation observance at all. +; +; That gap was architectural, not an oversight, and it is THIS task that +; closes it: until Date_spec grew `Easter_offset`, there was no (month, day) +; pair a Fixed spec could anchor to, which is exactly why the register +; concluded this "is not Commemoration_only sanctoral data by nature". With a +; movable spec it plainly is -- the identical shape `Add major-litanies` +; above already uses, differing only in how the date is expressed. +; +; RG 88: nothing is done in the Office, only the Mass -- so the Vigil's own +; office identity is CORRECTLY untouched; this entry is a commemoration and +; never competes for the observed slot (`Commemoration_only` -> band returns +; `unclassified`, checked first, ahead of every rank-keyed branch). +; +; RG 89: "Ad processionem aut alias peculiares supplicationes et Missam aut +; COMMEMORATIONEM quod attinet, serventur quae supra de Litaniis maioribus +; statuta sunt (nn. 81-83 et 86)". Note what follows: RG 109's closed list of +; privileged commemorations names only "de Litaniis MAIORIBUS" (f), never +; minoribus, so by RG 107's closing rule this is an ORDINARY commemoration -- +; unlike the Major Litanies' privileged one. That asymmetry is deliberate and +; is asserted in test_rite_ef.ml. +; +; Name: "feria IV Rogationum" is the Missal's own (scan1.txt:20495-20497, +; "Et in minoribus ante Ascensionem: feria II Rogationum, statio ad S. Mariam +; maiorem; feria III, statio ad S. Ioannem in Laterano; feria IV, statio ad +; S. Petrum"). Colour violet, matching the Rogation Monday/Tuesday offices +; `Temporal_ef` already builds. +; +; `subject Saint` matches `major-litanies` above. It is behaviourally INERT +; here, verified rather than assumed: `band` returns `unclassified` for any +; Commemoration_only candidate before reading subject at all, and the only +; other readers are RG 112(a) (fires on `Lord` only) and RG 112(d)'s +; `is_bvm_office` (`Bvm` only). `Temporal` would arguably describe both this +; and the Major Litanies better; changing them is a separate, zero-blast- +; radius tidy-up, deliberately not folded into this task. +; ; `Add barbara` -- a genuine DATA GAP, the same shape as the ef-rebootstrap ; task's five (agnes-secundo/boniface-martyr/eusebius-confessor/evaristus/ ; theodore, above): both scans, 4 December, carry a second line under S. @@ -330,6 +373,13 @@ (rank Class4) (status Commemoration_only) (colour Violet) (subject Saint) (citations ()) (layer ef-universal))))) (Add + ((date (Easter_offset 38)) + (cel + ((slug rogation-wednesday) + (names ((la "Feria IV Rogationum") (en "Rogation Wednesday"))) + (rank Class4) (status Commemoration_only) (colour Violet) + (subject Saint) (citations ()) (layer ef-universal))))) + (Add ((date (Fixed (month 12) (day 4))) (cel ((slug barbara) diff --git a/lib/kernel/calendar.ml b/lib/kernel/calendar.ml index 724641d..99992b3 100644 --- a/lib/kernel/calendar.ml +++ b/lib/kernel/calendar.ml @@ -58,7 +58,7 @@ let year_bounds (rite : ('s, 'r) Rite.t) (y : int) : Date.t * Date.t = [injected] is keyed by [Date.to_rata] rather than [Date.t] directly: [Date.t] carries no [compare]-respecting hash, and rata-die is already the canonical total order this module uses for date arithmetic. *) -let resolve_with_injected (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) +let resolve_with_injected (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index) (injected : (int, 'r Precedence.candidate list) Hashtbl.t) (date : Date.t) : ('s, 'r) Temporal.t * 's Precedence.context * 'r Precedence.resolution = let temporal = rite.Rite.temporal date in @@ -66,7 +66,7 @@ let resolve_with_injected (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) { Precedence.cel = temporal.Temporal.office; origin = Precedence.Temporal } in let natural = - Layer.on_date idx ~month:(Date.month date) ~day:(Date.day date) + Layer.on_date idx date |> List.map (fun (e : 'r Layer.entry) -> { Precedence.cel = e.Layer.cel; origin = Precedence.Sanctoral }) in @@ -81,7 +81,7 @@ let resolve_with_injected (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) placements decided so far -- this is exactly the [occupant] callback Rite.transfer_target's search walks forward with (rite.mli explains why that judgement has to come from the rite, not from here). *) -let occupant_of (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) +let occupant_of (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index) (injected : (int, 'r Precedence.candidate list) Hashtbl.t) (date : Date.t) : 'r Celebration.t = let _, _, resolution = resolve_with_injected rite idx injected date in resolution.Precedence.observed.Precedence.cel @@ -185,7 +185,7 @@ let injected_index_of_assignment (assignment : (string, Date.t * Date.t) Hashtbl [assignment], permanently (never retried -- [transfer_target] is a pure function of a candidate's own permanent origin and the occupancy state, so asking it again would only recompute the same out-of-range answer). *) -let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) ~(start : Date.t) +let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index) ~(start : Date.t) ~(stop : Date.t) (dates : Date.t array) : (string, Date.t * Date.t) Hashtbl.t * (string, 'r Precedence.candidate) Hashtbl.t @@ -273,7 +273,7 @@ let place_transfers (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) ~(start : went on to win) and [transferred_out] (whichever candidates' settled placements originated here -- RG 97-98 lets that be more than one; see [Liturgical_day.transferred_out]). *) -let build_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) +let build_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.index) (assignment : (string, Date.t * Date.t) Hashtbl.t) (out_of_range : (string, Date.t * Date.t) Hashtbl.t) (injected : (int, 'r Precedence.candidate list) Hashtbl.t) @@ -442,7 +442,15 @@ let build_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) let year (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (y : int) : ('s, 'r) Liturgical_day.t array = - let idx = Layer.index_by_date layer in + (* A liturgical year is Advent-anchored and straddles two civil years -- + [year_start y .. year_start (y+1) - 1] -- so BOTH must be resolved for + movable entries, or a movable feast in the tail of the span silently + vanishes. *) + (* A liturgical year straddles two civil years, so both are named. + [Layer.index] filters them to the kernel domain, which is what keeps + the edges (y = 1583 naming 1582, y = 9999 naming 10000) from + calling the rite's [easter] out of range. *) + let idx = Layer.index layer ~easter:rite.Rite.easter ~years:[ y - 1; y; y + 1 ] in let start, stop = year_bounds rite y in (* [max 0]: defends [Array.init] against a negative length, which would otherwise arise for a rite whose [year_start] lands exactly on the @@ -468,7 +476,7 @@ let year (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (y : int) : OCAMLRUNPARAM=R), so a day with more than one departure -- RG 97-98's coinciding-feasts case -- would otherwise report them in a run-dependent order: an environment read, in a kernel whose invariants - forbid one. [Layer.index_by_date] guards against exactly this by + forbid one. [Layer.index] guards against exactly this by re-sorting each date bucket after building it (layer.ml); same fix, same reason. Sorted by target date -- which, for a correctly-converged year, is also RG 97-98's own order: the higher-precedence loser claims diff --git a/lib/kernel/date_spec.ml b/lib/kernel/date_spec.ml index 732f6b1..6b328df 100644 --- a/lib/kernel/date_spec.ml +++ b/lib/kernel/date_spec.ml @@ -1,14 +1,33 @@ open Sexplib0.Sexp_conv -(* How a sanctoral entry expresses its date. Plan 2 ships the only form the EF - sanctoral needs -- a fixed calendar date -- because EF movable feasts come - from the rite's temporal code, not from data. Sunday-relative and - Easter-relative forms arrive with the OF sanctoral. *) +(* How a sanctoral entry expresses its date. + + Plan 2 shipped [Fixed] alone, and this file's own header then said + "Sunday-relative and Easter-relative forms arrive with the OF sanctoral". + They arrive here instead, ahead of OF, because two things needed them at + once: user-supplied overlays carrying LOCAL MOVABLE FEASTS (a patronal + feast on "the first Sunday of October" was simply inexpressible), and + ROGATION WEDNESDAY's own commemoration (RG 87/88/89), recorded as + architecturally blocked since 2026-08-13 for exactly one reason -- its + trigger is Easter+38, and there is no (month, day) pair a [Fixed] spec + could anchor to. + + Sunday-relative forms ("the Sunday on or after 2 November") are still NOT + built: no entry in this repository needs one, and the same mechanism adds + them when one does. See + docs/superpowers/specs/2026-08-17-colitur-movable-date-specs-design.md. *) module Repr = struct - type t = Fixed of { month : int; day : int } [@@deriving sexp] + type t = + | Fixed of { month : int; day : int } + | Easter_offset of int + | Nth_weekday of { month : int; nth : int; weekday : Date.weekday } + [@@deriving sexp] end -type t = Repr.t = Fixed of { month : int; day : int } +type t = Repr.t = + | Fixed of { month : int; day : int } + | Easter_offset of int + | Nth_weekday of { month : int; nth : int; weekday : Date.weekday } (* Leap-year maximum, so 29 February is constructible; it simply does not resolve in a common year. *) @@ -24,20 +43,89 @@ let fixed ~month ~day = Error (Printf.sprintf "date_spec: day %d out of range for month %d" day month) else Ok (Fixed { month; day }) -let resolve t ~year = +(* Deliberately generous rather than tight. Septuagesima is Easter-63 and Time + after Pentecost runs well past Easter+180, so a bound that merely LOOKED + precise would reject legitimate specs; a full year either way is the point + past which a spec is certainly a data error rather than a calendar. *) +let easter_offset n = + if n < -365 || n > 365 then + Error (Printf.sprintf "date_spec: easter offset %d is further than a year from Easter" n) + else Ok (Easter_offset n) + +(* [nth] is 1-based forward, or negative from the end (-1 = the last). Zero is + meaningless, and no month has a sixth of any weekday. *) +let nth_weekday ~month ~nth ~weekday = + if month < 1 || month > 12 then Error (Printf.sprintf "date_spec: month %d out of range 1..12" month) + else if nth = 0 then Error "date_spec: nth = 0 is meaningless (1 is the first, -1 the last)" + else if nth < -5 || nth > 5 then + Error (Printf.sprintf "date_spec: nth %d out of range (no month has six of a weekday)" nth) + else Ok (Nth_weekday { month; nth; weekday }) + +(* The domain check on [Easter_offset] is load-bearing, not defensive + decoration: date.mli states plainly that [add_days] is "unbounded total + arithmetic (they may denote a date outside the domain)", so Easter+200 in + 9999 yields a perfectly well-formed [Date.t] that is nonetheless outside + 1583..9999. Returning it would leak an out-of-domain date into a [Layer] + index and from there into resolution. [None] is the same answer 29 February + already gives in a common year: "this spec does not occur". *) +let in_domain d = Date.year d >= 1583 && Date.year d <= 9999 + +let weekday_index = function + | Date.Sun -> 0 + | Date.Mon -> 1 + | Date.Tue -> 2 + | Date.Wed -> 3 + | Date.Thu -> 4 + | Date.Fri -> 5 + | Date.Sat -> 6 + +(* Total: every branch returns [option], and nothing here raises on an in-range + year. *) +let resolve t ~year ~easter = match t with | Fixed { month; day } -> Result.to_option (Date.make ~year ~month ~day) + | Easter_offset n -> + (* [easter] is the caller's Easter for THIS civil year -- the rite + supplies it ({!Rite.t}'s own [easter] field), so a Julian-reckoning + rite is never silently handed a Gregorian date. *) + let d = Date.add_days easter n in + if in_domain d then Some d else None + | Nth_weekday { month; nth; weekday } -> ( + match Date.make ~year ~month ~day:1 with + | Error _ -> None + | Ok first -> + (* [Date.make] is the authority on month length, so no leap rule is + duplicated here: probe downward from 31 for the last day that + actually constructs. Every month has at least 28. *) + let rec last_day d = + if d <= 28 then d else if Result.is_ok (Date.make ~year ~month ~day:d) then d else last_day (d - 1) + in + let days_in_month = last_day 31 in + let offset_to_first = (weekday_index weekday - weekday_index (Date.weekday first) + 7) mod 7 in + let first_occurrence = 1 + offset_to_first in + let count = ((days_in_month - first_occurrence) / 7) + 1 in + (* Negative [nth] counts back from the end: -1 is the last. *) + let index = if nth > 0 then nth else count + nth + 1 in + if index < 1 || index > count then None + else Result.to_option (Date.make ~year ~month ~day:(first_occurrence + ((index - 1) * 7)))) let sexp_of_t = Repr.sexp_of_t (* Validating parser, matching Slug and Lang: [ppx_sexp_conv]'s derived - [t_of_sexp] (relocated to [Repr] above) accepts any in-range int pair, so - [(Fixed (month 13) (day 40))] would otherwise deserialise into a spec that - silently never resolves -- a saint quietly vanishing with no diagnostic. - Re-running the value through [fixed] closes that gap the same way loaders - already close it for slugs and language codes. *) + [t_of_sexp] (relocated to [Repr] above) accepts any in-range int, so + [(Fixed (month 13) (day 40))] or [(Nth_weekday (month 10) (nth 0) ...)] + would otherwise deserialise into a spec that silently never resolves -- a + celebration quietly vanishing with no diagnostic. Re-running the value + through the smart constructors closes that gap the same way loaders already + close it for slugs and language codes. + + EVERY variant is re-validated here. Adding one without extending this + function reopens exactly the hole it exists to close, and the failure mode + is invisible: nothing errors, a feast simply never appears. *) let t_of_sexp sexp = - let (Fixed { month; day }) = Repr.t_of_sexp sexp in - match fixed ~month ~day with - | Ok t -> t - | Error msg -> Sexplib0.Sexp_conv.of_sexp_error msg sexp + let reject msg = Sexplib0.Sexp_conv.of_sexp_error msg sexp in + match Repr.t_of_sexp sexp with + | Fixed { month; day } -> ( match fixed ~month ~day with Ok t -> t | Error msg -> reject msg) + | Easter_offset n -> ( match easter_offset n with Ok t -> t | Error msg -> reject msg) + | Nth_weekday { month; nth; weekday } -> ( + match nth_weekday ~month ~nth ~weekday with Ok t -> t | Error msg -> reject msg) diff --git a/lib/kernel/date_spec.mli b/lib/kernel/date_spec.mli index 3fe9625..70a3030 100644 --- a/lib/kernel/date_spec.mli +++ b/lib/kernel/date_spec.mli @@ -1,9 +1,45 @@ -(** A sanctoral entry's date expression. *) -type t = Fixed of { month : int; day : int } [@@deriving sexp] +(** A sanctoral entry's date expression. + + [Fixed] is a civil (month, day) that recurs every year. The other two move: + [Easter_offset] is a signed day count from the rite's own Easter, and + [Nth_weekday] is the nth (or nth-from-last) given weekday of a month. + + Sunday-relative forms ("the Sunday on or after 2 November") are + deliberately absent: nothing in this repository needs one yet, and the same + mechanism admits them when something does. *) +type t = + | Fixed of { month : int; day : int } + | Easter_offset of int + | Nth_weekday of { month : int; nth : int; weekday : Date.weekday } +[@@deriving sexp] (** Validates against the leap-year maximum, so 29 February is constructible. *) val fixed : month:int -> day:int -> (t, string) result -(** [None] when the spec does not occur in that year (29 February in a common - year) or falls outside the supported domain. *) -val resolve : t -> year:int -> Date.t option +(** Rejects an offset further than a year from Easter in either direction -- + past that, a spec is a data error rather than a calendar. Deliberately + generous: Septuagesima is Easter-63 and Time after Pentecost runs well past + Easter+180. *) +val easter_offset : int -> (t, string) result + +(** [nth] is 1-based forward, or negative from the end ([-1] is the last). + Rejects [nth = 0] (meaningless), [|nth| > 5] (no month has six of any + weekday), and a month outside 1..12. *) +val nth_weekday : month:int -> nth:int -> weekday:Date.weekday -> (t, string) result + +(** [resolve spec ~year ~easter] is the civil date [spec] denotes in [year], + where [easter] is that year's Easter as the RITE reckons it -- supplied by + the caller, never computed here, since {!Computus} ships both Gregorian and + Julian and choosing one in the kernel would be silently wrong for a + Julian-reckoning rite. + + [None] means "this spec does not occur in that year", per variant: + - [Fixed]: 29 February in a common year, or a date outside 1583..9999. + - [Easter_offset]: the resolved date falls outside 1583..9999. This is + reachable at the domain edges -- {!Date.add_days} is unbounded total + arithmetic and will happily denote a date outside the domain. + - [Nth_weekday]: the month has no such occurrence (a fifth Sunday it + lacks). + + Total: never raises on any in-range year, for any constructible spec. *) +val resolve : t -> year:int -> easter:Date.t -> Date.t option diff --git a/lib/kernel/layer.ml b/lib/kernel/layer.ml index 515b052..ec074a7 100644 --- a/lib/kernel/layer.ml +++ b/lib/kernel/layer.ml @@ -20,26 +20,63 @@ let set t entry = let t = remove t entry.cel.Celebration.slug in { t with entries = canonical (entry :: t.entries) } -(* Dates are year-independent, so the index is built once per layer rather than - once per year -- a full 1583..9999 sweep would otherwise rescan the entry - list for every day. *) -type 'r by_date = (int * int, 'r entry list) Hashtbl.t +(* FIXED entries are year-independent, so their table is built once and keyed + (month, day) -- a full 1583..9999 sweep would otherwise rescan the entry + list for every day. -let key = function Date_spec.Fixed { month; day } -> (month, day) + MOVABLE entries have no such key BY CONSTRUCTION: the same spec lands on a + different (month, day) in different years, so one year-independent table + cannot serve a multi-year span. They are resolved once per civil year in + the span and keyed by rata die instead. -let index_by_date t = - let tbl : 'r by_date = Hashtbl.create 512 in + Keeping the two separate, rather than resolving everything per year, + preserves the fixed path exactly as it was -- including the "30 November + counted twice in a 371-day liturgical span" behaviour validate.mli + documents for St Andrew, which falls straight out of querying by (month, + day) and would have to be re-established by hand under a uniform rata-die + index. *) +type 'r index = { + fixed : (int * int, 'r entry list) Hashtbl.t; + movable : (int, 'r entry list) Hashtbl.t; (** keyed by rata die *) +} + +let index t ~easter ~years = + (* Filter to the kernel domain BEFORE calling [easter] on anything. A + liturgical year is Advent-anchored, so a caller resolving civil year [y] + legitimately names [y - 1] or [y + 1] -- and at the two edges those are + 1582 and 10000, which {!Computus} correctly refuses by raising. Both + edges bit during development (the ceiling via the domain-ceiling test, + the floor via `colitur day 1583`), which is why the guard lives HERE, at + the single point that calls [easter], rather than as a clamp repeated in + every caller. A spec cannot resolve outside 1583..9999 anyway, so + dropping those years loses nothing. *) + let years = List.filter (fun y -> y >= 1583 && y <= 9999) years in + let fixed : (int * int, 'r entry list) Hashtbl.t = Hashtbl.create 512 in + let movable : (int, 'r entry list) Hashtbl.t = Hashtbl.create 32 in + let add tbl k e = Hashtbl.replace tbl k (e :: (try Hashtbl.find tbl k with Not_found -> [])) in List.iter (fun e -> - let k = key e.date in - Hashtbl.replace tbl k (e :: (try Hashtbl.find tbl k with Not_found -> []))) + match e.date with + | Date_spec.Fixed { month; day } -> add fixed (month, day) e + | _ -> + (* A spec resolving to nothing in a given year is not an error: + [Date_spec.resolve]'s own [None] means "does not occur this + year", the same contract 29 February has always had. *) + List.iter + (fun year -> + match Date_spec.resolve e.date ~year ~easter:(easter year) with + | Some d -> add movable (Date.to_rata d) e + | None -> ()) + years) t.entries; - (* restore canonical order within each date bucket *) - Hashtbl.iter (fun k v -> Hashtbl.replace tbl k (canonical v)) tbl; - tbl + Hashtbl.iter (fun k v -> Hashtbl.replace fixed k (canonical v)) fixed; + Hashtbl.iter (fun k v -> Hashtbl.replace movable k (canonical v)) movable; + { fixed; movable } -let on_date tbl ~month ~day = - try Hashtbl.find tbl (month, day) with Not_found -> [] +let on_date idx date = + let f = try Hashtbl.find idx.fixed (Date.month date, Date.day date) with Not_found -> [] in + let m = try Hashtbl.find idx.movable (Date.to_rata date) with Not_found -> [] in + match m with [] -> f | _ -> canonical (f @ m) let load rank_of_sexp path = match Sexplib.Sexp.load_sexp path with diff --git a/lib/kernel/layer.mli b/lib/kernel/layer.mli index 3092353..ab6e56b 100644 --- a/lib/kernel/layer.mli +++ b/lib/kernel/layer.mli @@ -15,10 +15,29 @@ val remove : 'r t -> Slug.t -> 'r t (** Date index. Built once per layer, not per year: [Date_spec] dates are year-independent. *) -type 'r by_date +type 'r index -val index_by_date : 'r t -> 'r by_date -val on_date : 'r by_date -> month:int -> day:int -> 'r entry list +(** [index t ~easter ~years] builds the per-date lookup for [t]. + + Fixed entries are keyed (month, day), year-independently, as they always + were. Movable entries ({!Date_spec.Easter_offset}, {!Date_spec.Nth_weekday}) + have no year-independent key, so they are resolved once for each civil year + in [years] and keyed by rata die. [easter] supplies that year's Easter as + the RITE reckons it -- see {!Rite.t}'s own [easter] field. + + [years] must list every civil year the caller's span touches. A liturgical + year is Advent-anchored and straddles two, so {!Calendar.year} and + {!Validate.run} both pass [[y; y + 1]]. A movable entry whose year is + omitted is simply absent from the index -- silently, so getting [years] + wrong loses celebrations rather than erroring. + + NOTE the index is therefore no longer built once per layer independent of + year: for fixed entries it still is, for movable ones it is per-span. *) +val index : 'r t -> easter:(int -> Date.t) -> years:int list -> 'r index + +(** Entries falling on [date], fixed and movable together, in the layer's + canonical slug order. *) +val on_date : 'r index -> Date.t -> 'r entry list (** Loads a layer from a sexp file. Parse and validation failures come back as [Error], never as an exception. *) diff --git a/lib/kernel/rite.ml b/lib/kernel/rite.ml index 91326a6..600a691 100644 --- a/lib/kernel/rite.ml +++ b/lib/kernel/rite.ml @@ -7,6 +7,7 @@ type ('s, 'r) t = { year_start : int -> Date.t; temporal : Date.t -> ('s, 'r) Temporal.t; anchors : int -> (string * Date.t) list; + easter : int -> Date.t; rules : ('s, 'r) Precedence.rules; season_runs : 's list; transfer_target : diff --git a/lib/kernel/rite.mli b/lib/kernel/rite.mli index a41e034..0324bf2 100644 --- a/lib/kernel/rite.mli +++ b/lib/kernel/rite.mli @@ -10,6 +10,13 @@ type ('s, 'r) t = { temporal : Date.t -> ('s, 'r) Temporal.t; anchors : int -> (string * Date.t) list; (** Easter-derived days: (expected slug, date) *) + easter : int -> Date.t; + (** The rite's own Easter for civil year [y]. Supplied by the rite, NOT + computed in the kernel: {!Computus} ships both Gregorian and Julian + reckonings, and choosing one here would hard-code a Roman assumption + into rite-agnostic code and be silently wrong for a Julian-reckoning + rite. Read by {!Layer.index} to resolve + {!Date_spec.Easter_offset}. *) rules : ('s, 'r) Precedence.rules; season_runs : 's list; (** the expected run-length-compressed season sequence over one liturgical diff --git a/lib/kernel/validate.ml b/lib/kernel/validate.ml index 1a0248b..c9d4263 100644 --- a/lib/kernel/validate.ml +++ b/lib/kernel/validate.ml @@ -220,7 +220,14 @@ let run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year = (Printf.sprintf "resolving the year raised (%s); nothing could be verified as accounted for" (Printexc.to_string exn)) | resolved -> - let idx = Layer.index_by_date layer in + (* Same span reasoning as {!Calendar.year}: the liturgical year + straddles civil [year] and [year + 1], so both are resolved for + movable entries. *) + (* A liturgical year straddles two civil years, so both are named. + [Layer.index] filters them to the kernel domain, which is what keeps + the edges (year = 1583 naming 1582, year = 9999 naming 10000) from + calling the rite's [easter] out of range. *) + let idx = Layer.index layer ~easter:rite.Rite.easter ~years:[ year - 1; year; year + 1 ] in let bump tbl slug = Hashtbl.replace tbl slug (1 + (try Hashtbl.find tbl slug with Not_found -> 0)) in (* Expected: how many times each layer entry's own Date_spec resolves within [start, stop]. Walking dates and querying [Layer.on_date] @@ -232,7 +239,7 @@ let run (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) ~year = let expected : (string, int) Hashtbl.t = Hashtbl.create 64 in List.iter (fun date -> - Layer.on_date idx ~month:(Date.month date) ~day:(Date.day date) + Layer.on_date idx date |> List.iter (fun (e : 'r Layer.entry) -> bump expected (Slug.to_string e.Layer.cel.Celebration.slug))) days; diff --git a/lib/rites/rite_ef/rite_ef.ml b/lib/rites/rite_ef/rite_ef.ml index 60065b7..a8a9703 100644 --- a/lib/rites/rite_ef/rite_ef.ml +++ b/lib/rites/rite_ef/rite_ef.ml @@ -33,6 +33,11 @@ let context ~lectionary ~commons : (Vocab_ef.season, Vocab_ef.rank) Rite.t = year_start = Temporal_ef.year_start; temporal = Temporal_ef.temporal; anchors = Temporal_ef.anchors; + (* RG's own computus: the Roman rite reckons Easter on the Gregorian + calendar. Supplied here rather than assumed by the kernel, so a + Julian-reckoning rite can supply {!Computus.julian_easter} + instead. Read by [Layer.index] for [Date_spec.Easter_offset]. *) + easter = Colitur_kernel.Computus.gregorian_easter; rules = { Precedence.band = Precedence_ef.band; disposition = Precedence_ef.disposition; diff --git a/test/test_calendar.ml b/test/test_calendar.ml index a533ab2..59624aa 100644 --- a/test/test_calendar.ml +++ b/test/test_calendar.ml @@ -105,6 +105,11 @@ module Fixture = struct let rite : (season, rank) Rite.t = { Rite.id = "synthetic-calendar"; vocab; year_start; temporal; anchors = (fun _ -> []); + (* Not a Roman rite, but a Rite.t must supply SOME Easter now that + movable Date_spec variants exist. The Gregorian one is as good as + any for a fixture; nothing here is Easter-relative, so the value + is never actually read. *) + easter = Colitur_kernel.Computus.gregorian_easter; rules; season_runs = [ A; B ]; transfer_target; readings } let entry ~month ~day ~slug ~rank = diff --git a/test/test_golden.ml b/test/test_golden.ml index e9b3ec5..a073c52 100644 --- a/test/test_golden.ml +++ b/test/test_golden.ml @@ -1281,6 +1281,40 @@ let test_readings_displaced_sunday_feria_known_divergent () = 2026 10 26 "2026-10-26 slug=ef-time-after-pentecost-22-monday first=Col 1:12-20. gospel=John 18:33-37" + +(* ---- Rogation Wednesday (RG 87/88/89), movable-date-specs task ---- + + RG 87, verbatim (scan1.txt:691): "Litaniae minores seu Rogationes, per se, + assignantur feriis II, III et IV ante festum Ascensionis Domini" -- Monday, + Tuesday AND Wednesday. colitur built the first two as temporal offices from + the start; the Wednesday had no channel at all until Date_spec grew + [Easter_offset], because Easter+38 IS the Ascension Vigil by construction + and there is no (month, day) a Fixed spec could anchor to. + + RG 88 keeps it out of the Office entirely, so the Vigil remains the + observed day and this is only ever a commemoration. RG 89 routes it through + the Major Litanies' rules -- but RG 109's closed list of privileged + commemorations names only "de Litaniis MAIORIBUS", never minoribus, so by + RG 107's closing rule it is ORDINARY. That asymmetry is the whole point of + pinning two years rather than one: + + 2024 -- nothing else competes, so the single commemoration RG 111 allows on + a II-class day is the Rogation itself. + 2026 -- St Robert Bellarmine (III class) is impeded onto the same day and + takes that one slot instead: RG 113 orders admissions by RG 91's table, and + a Commemoration_only candidate has no row in it at all (band returns + [unclassified]), so a genuine feast outranks it. + + Both weekdays independently checked with `date -d`. *) +let test_rogation_wednesday_admitted_2024 () = + check ~msg:"2024: Rogation Wednesday is the one admitted commemoration" 2024 5 8 + "2024-05-08 wednesday season=paschaltide week=6 slug=ef-ascension-vigil rank=class-2 colour=white subject=temporal name_la=- comms=[rogation-wednesday:ordinary] in=- out=[]" + +let test_rogation_wednesday_yields_to_a_feast_2026 () = + check ~msg:"2026: an impeded III-class feast takes the single slot instead" 2026 5 13 + "2026-05-13 wednesday season=paschaltide week=6 slug=ef-ascension-vigil rank=class-2 colour=white \ + subject=temporal name_la=- comms=[robert-bellarmine:ordinary] in=- out=[]" + let suite = ( "golden pins (known-tricky years)", [ Alcotest.test_case "Easter extreme: 1598 earliest (22 Mar, Gauss-verified)" `Quick @@ -1371,5 +1405,9 @@ let suite = test_readings_step4_common_frances; Alcotest.test_case "readings: displaced-Sunday feria pins M26 shape 2(b)'s KNOWN-WRONG walkback (2026-10-26)" `Quick - test_readings_displaced_sunday_feria_known_divergent + test_readings_displaced_sunday_feria_known_divergent; + Alcotest.test_case "RG87: Rogation Wednesday admitted (2024)" `Quick + test_rogation_wednesday_admitted_2024; + Alcotest.test_case "RG87/113: Rogation Wednesday yields to an impeded feast (2026)" `Quick + test_rogation_wednesday_yields_to_a_feast_2026 ] ) diff --git a/test/test_names.ml b/test/test_names.ml index cef7357..f3cdc54 100644 --- a/test/test_names.ml +++ b/test/test_names.ml @@ -2,6 +2,11 @@ module N = Colitur_kernel.Names module L = Colitur_kernel.Lang module C = Colitur_kernel.Citation module DS = Colitur_kernel.Date_spec + +(* Task: Date_spec.resolve now takes the rite's own Easter (movable specs). + These fixtures are all [Fixed], so the value is irrelevant to them -- but it + must be supplied, and the Gregorian one is the honest choice here. *) +let easter_of y = Colitur_kernel.Computus.gregorian_easter y module D = Colitur_kernel.Date let lang s = L.of_string_exn s @@ -52,15 +57,15 @@ let test_citation () = let test_date_spec () = (match DS.fixed ~month:3 ~day:25 with | Ok ds -> ( - match DS.resolve ds ~year:2026 with + match DS.resolve ds ~year:2026 ~easter:(easter_of 2026) with | Some d -> Alcotest.(check string) "resolve" "2026-03-25" (D.to_iso8601 d) | None -> Alcotest.fail "resolve returned None") | Error e -> Alcotest.failf "fixed: %s" e); (* Feb 29 is a legitimate fixed date that simply does not occur every year. *) (match DS.fixed ~month:2 ~day:29 with | Ok ds -> - Alcotest.(check bool) "Feb 29 resolves in 2024" true (DS.resolve ds ~year:2024 <> None); - Alcotest.(check bool) "Feb 29 absent in 2026" true (DS.resolve ds ~year:2026 = None) + Alcotest.(check bool) "Feb 29 resolves in 2024" true (DS.resolve ds ~year:2024 ~easter:(easter_of 2024) <> None); + Alcotest.(check bool) "Feb 29 absent in 2026" true (DS.resolve ds ~year:2026 ~easter:(easter_of 2026) = None) | Error e -> Alcotest.failf "Feb 29 must be constructible: %s" e); Alcotest.(check bool) "reject Feb 30" true (Result.is_error (DS.fixed ~month:2 ~day:30)); Alcotest.(check bool) "reject Apr 31" true (Result.is_error (DS.fixed ~month:4 ~day:31)); @@ -176,6 +181,118 @@ let test_record () = [ "2026-04-05"; "ef"; "ordinary"; "1"; "sunday"; "ef-easter-sunday"; "high"; "white"; "lord" ] (Rec.to_row r) + +(* ---- movable Date_spec variants (2026-08-17) ---- + Every date literal below was checked against `date -d` before being typed, + the same rule test_golden.ml states for itself. Easter 2026 is 5 April. *) + +let easter_2026 = easter_of 2026 + +let test_easter_offset_resolves () = + let ds = match DS.easter_offset 38 with Ok d -> d | Error e -> failwith e in + (* Easter 2026 = 5 April; +38 = 13 May, the Wednesday before Ascension -- + the offset Rogation Wednesday needs (RG 87). *) + Alcotest.(check string) "Easter+38 in 2026" "2026-05-13" + (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none") + +let test_easter_offset_zero_is_easter () = + let ds = match DS.easter_offset 0 with Ok d -> d | Error e -> failwith e in + Alcotest.(check string) "Easter+0 is Easter itself" "2026-04-05" + (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none") + +let test_easter_offset_negative () = + let ds = match DS.easter_offset (-46) with Ok d -> d | Error e -> failwith e in + (* Ash Wednesday 2026 is 18 February, Easter-46. *) + Alcotest.(check string) "Easter-46 is Ash Wednesday" "2026-02-18" + (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none") + +let test_nth_weekday_first_sunday_october () = + let ds = match DS.nth_weekday ~month:10 ~nth:1 ~weekday:D.Sun with Ok d -> d | Error e -> failwith e in + (* 1 October 2026 is a Thursday, so the first Sunday is the 4th. *) + Alcotest.(check string) "first Sunday of October 2026" "2026-10-04" + (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none") + +let test_nth_weekday_last_sunday_october () = + let ds = match DS.nth_weekday ~month:10 ~nth:(-1) ~weekday:D.Sun with Ok d -> d | Error e -> failwith e in + Alcotest.(check string) "last Sunday of October 2026" "2026-10-25" + (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none") + +let test_nth_weekday_absent_fifth () = + let ds = match DS.nth_weekday ~month:10 ~nth:5 ~weekday:D.Sun with Ok d -> d | Error e -> failwith e in + (* October 2026 has four Sundays (4, 11, 18, 25). A fifth is not an error -- + it simply does not occur, the same contract 29 February has. *) + Alcotest.(check bool) "a fifth Sunday the month lacks resolves to None" true + (DS.resolve ds ~year:2026 ~easter:easter_2026 = None) + +let test_nth_weekday_february_leap_edge () = + let ds = match DS.nth_weekday ~month:2 ~nth:(-1) ~weekday:D.Sat with Ok d -> d | Error e -> failwith e in + (* 2024 is a leap year; 29 February is a Thursday, so the last Saturday is + the 24th. Exercises the month-length probe against Date.make rather than + a duplicated leap rule. *) + Alcotest.(check string) "last Saturday of February 2024" "2024-02-24" + (match DS.resolve ds ~year:2024 ~easter:(easter_of 2024) with Some d -> D.to_iso8601 d | None -> "none") + +let test_movable_constructors_reject_nonsense () = + Alcotest.(check bool) "nth = 0 rejected" true (Result.is_error (DS.nth_weekday ~month:10 ~nth:0 ~weekday:D.Sun)); + Alcotest.(check bool) "nth = 6 rejected" true (Result.is_error (DS.nth_weekday ~month:10 ~nth:6 ~weekday:D.Sun)); + Alcotest.(check bool) "nth = -6 rejected" true (Result.is_error (DS.nth_weekday ~month:10 ~nth:(-6) ~weekday:D.Sun)); + Alcotest.(check bool) "month 13 rejected" true (Result.is_error (DS.nth_weekday ~month:13 ~nth:1 ~weekday:D.Sun)); + Alcotest.(check bool) "offset 400 rejected" true (Result.is_error (DS.easter_offset 400)); + Alcotest.(check bool) "offset -400 rejected" true (Result.is_error (DS.easter_offset (-400))) + +(* The failure this guards is INVISIBLE: an unvalidated spec deserialises into + something that silently never resolves, and a celebration vanishes with no + diagnostic anywhere. Date_spec quarantines the derived parser in [Repr] and + re-validates in a hand-written [t_of_sexp] for exactly that reason; the two + new variants are held to it too, or the guarantee is only partial. *) +let test_movable_sexp_parser_rejects_invalid () = + List.iter + (fun s -> + Alcotest.(check bool) + (Printf.sprintf "rejects %s" s) + true + (try + ignore (DS.t_of_sexp (Sexplib.Sexp.of_string s)); + false + with _ -> true)) + [ "(Nth_weekday (month 10) (nth 0) (weekday Sun))"; + "(Nth_weekday (month 13) (nth 1) (weekday Sun))"; + "(Nth_weekday (month 10) (nth 9) (weekday Sun))"; + "(Easter_offset 100000)"; + "(Easter_offset -100000)" ] + +let test_movable_sexp_roundtrip () = + List.iter + (fun ds -> Alcotest.(check bool) "sexp round-trips" true (DS.t_of_sexp (DS.sexp_of_t ds) = ds)) + [ (match DS.fixed ~month:6 ~day:30 with Ok d -> d | Error e -> failwith e); + (match DS.easter_offset 38 with Ok d -> d | Error e -> failwith e); + (match DS.easter_offset (-63) with Ok d -> d | Error e -> failwith e); + (match DS.nth_weekday ~month:10 ~nth:1 ~weekday:D.Sun with Ok d -> d | Error e -> failwith e); + (match DS.nth_weekday ~month:10 ~nth:(-1) ~weekday:D.Sat with Ok d -> d | Error e -> failwith e) ] + +(* Year-independent properties: the confidence-past-2050 mechanism. *) +let prop_nth_weekday_lands_correctly = + QCheck.Test.make ~count:500 ~name:"Nth_weekday resolves into its own month with its own weekday" + QCheck.(triple (int_range 1583 9998) (int_range 1 12) (int_range 1 5)) + (fun (year, month, nth) -> + match DS.nth_weekday ~month ~nth ~weekday:D.Sun with + | Error _ -> false + | Ok ds -> ( + match DS.resolve ds ~year ~easter:(easter_of year) with + | None -> true (* a 5th Sunday the month lacks: legitimate *) + | Some d -> D.month d = month && D.weekday d = D.Sun)) + +let prop_easter_offset_is_exactly_that_offset = + QCheck.Test.make ~count:500 ~name:"Easter_offset n resolves exactly n days from Easter" + QCheck.(pair (int_range 1600 9900) (int_range (-60) 200)) + (fun (year, n) -> + match DS.easter_offset n with + | Error _ -> false + | Ok ds -> ( + match DS.resolve ds ~year ~easter:(easter_of year) with + | None -> false + | Some d -> D.to_rata d - D.to_rata (easter_of year) = n)) + let suite = ( "Names/Citation/DateSpec", [ Alcotest.test_case "names basics" `Quick test_names_basics; @@ -187,6 +304,18 @@ let suite = Alcotest.test_case "date_spec" `Quick test_date_spec; Alcotest.test_case "date_spec sexp roundtrip" `Quick test_date_spec_sexp_roundtrip; Alcotest.test_case "date_spec sexp validates" `Quick test_date_spec_sexp_validates; + Alcotest.test_case "Easter_offset resolves" `Quick test_easter_offset_resolves; + Alcotest.test_case "Easter_offset 0 is Easter" `Quick test_easter_offset_zero_is_easter; + Alcotest.test_case "Easter_offset negative" `Quick test_easter_offset_negative; + Alcotest.test_case "Nth_weekday first Sunday" `Quick test_nth_weekday_first_sunday_october; + Alcotest.test_case "Nth_weekday last Sunday" `Quick test_nth_weekday_last_sunday_october; + Alcotest.test_case "Nth_weekday absent fifth" `Quick test_nth_weekday_absent_fifth; + Alcotest.test_case "Nth_weekday February leap edge" `Quick test_nth_weekday_february_leap_edge; + Alcotest.test_case "movable constructors reject nonsense" `Quick test_movable_constructors_reject_nonsense; + Alcotest.test_case "movable sexp parser rejects invalid" `Quick test_movable_sexp_parser_rejects_invalid; + Alcotest.test_case "movable sexp roundtrip" `Quick test_movable_sexp_roundtrip; Alcotest.test_case "celebration" `Quick test_celebration; Alcotest.test_case "celebration status" `Quick test_celebration_status; - Alcotest.test_case "record" `Quick test_record ] ) + Alcotest.test_case "record" `Quick test_record ] + @ List.map QCheck_alcotest.to_alcotest + [ prop_nth_weekday_lands_correctly; prop_easter_offset_is_exactly_that_offset ] ) diff --git a/test/test_overlay.ml b/test/test_overlay.ml index b5edd5a..f3d1aee 100644 --- a/test/test_overlay.ml +++ b/test/test_overlay.ml @@ -1,4 +1,7 @@ module L = Colitur_kernel.Layer + +let mkdate y m d = + match Colitur_kernel.Date.make ~year:y ~month:m ~day:d with Ok x -> x | Error e -> failwith e module Cel = Colitur_kernel.Celebration module S = Colitur_kernel.Slug module DS = Colitur_kernel.Date_spec @@ -47,9 +50,9 @@ let test_layer_basics () = (List.map (fun e -> S.to_string e.L.cel.Cel.slug) l.L.entries) let test_layer_index () = - let idx = L.index_by_date (base ()) in - Alcotest.(check int) "Jan 14 has one" 1 (List.length (L.on_date idx ~month:1 ~day:14)); - Alcotest.(check int) "Jan 20 has none" 0 (List.length (L.on_date idx ~month:1 ~day:20)) + let idx = L.index (base ()) ~easter:Colitur_kernel.Computus.gregorian_easter ~years:[ 2026 ] in + Alcotest.(check int) "Jan 14 has one" 1 (List.length (L.on_date idx (mkdate 2026 1 14))); + Alcotest.(check int) "Jan 20 has none" 0 (List.length (L.on_date idx (mkdate 2026 1 20))) (* Three entries sharing a date, inserted deliberately out of canonical (by-slug) order: this is what actually pins accumulation (the bucket must @@ -61,8 +64,8 @@ let test_layer_index_same_date () = L.of_entries ~id:"base" ~name:"Test same-date" [ entry ~month:3 ~day:17 "zeta"; entry ~month:3 ~day:17 "alpha"; entry ~month:3 ~day:17 "mu" ] in - let idx = L.index_by_date l in - let bucket = L.on_date idx ~month:3 ~day:17 in + let idx = L.index l ~easter:Colitur_kernel.Computus.gregorian_easter ~years:[ 2026 ] in + let bucket = L.on_date idx (mkdate 2026 3 17) in Alcotest.(check int) "three entries share Mar 17" 3 (List.length bucket); Alcotest.(check (list string)) "bucket sorted by slug" [ "alpha"; "mu"; "zeta" ] (List.map (fun e -> S.to_string e.L.cel.Cel.slug) bucket) diff --git a/test/test_rite_ef.ml b/test/test_rite_ef.ml index a014977..4da6d73 100644 --- a/test/test_rite_ef.ml +++ b/test/test_rite_ef.ml @@ -261,7 +261,7 @@ let test_barbara_added () = | None -> Alcotest.fail "slug barbara not found in the overlaid layer (ef-sanctoral-audit Add missing?)" | Some e -> Alcotest.(check bool) "barbara: 4 December" true - (match e.Layer.date with Date_spec.Fixed { month = 12; day = 4 } -> true | Date_spec.Fixed _ -> false); + (match e.Layer.date with Date_spec.Fixed { month = 12; day = 4 } -> true | _ -> false); Alcotest.(check bool) "barbara: Commemoration_only (no separate feast row in the calendarium, a bare \ \"Commemoratio\" nested under Peter Chrysologus)" true (e.Layer.cel.Cel.status = Cel.Commemoration_only); diff --git a/test/test_sanctoral_ef.ml b/test/test_sanctoral_ef.ml index 2024dc2..ebf96dc 100644 --- a/test/test_sanctoral_ef.ml +++ b/test/test_sanctoral_ef.ml @@ -91,7 +91,7 @@ let test_load_and_counts () = leap year (2028: divisible by 4, not by 100). *) List.iter (fun e -> - match DS.resolve e.L.date ~year:2028 with + match DS.resolve e.L.date ~year:2028 ~easter:(Colitur_kernel.Computus.gregorian_easter 2028) with | Some _ -> () | None -> Alcotest.failf "slug %s: date does not resolve in leap year 2028" (S.to_string e.L.cel.Cel.slug)) l.L.entries diff --git a/test/test_validate.ml b/test/test_validate.ml index 1a960df..4d5458f 100644 --- a/test/test_validate.ml +++ b/test/test_validate.ml @@ -321,6 +321,11 @@ module Synthetic = struct ?(transfer_target = fun _ origin _ -> origin) ?(readings = readings) temporal : (season, rank) Rite.t = { Rite.id = "synthetic"; vocab; year_start; temporal; anchors; rules; season_runs; + (* Not a Roman rite, but a Rite.t must supply SOME Easter now that + movable Date_spec variants exist. The Gregorian one is as good as + any for a fixture; nothing here is Easter-relative, so the value + is never actually read. *) + easter = Colitur_kernel.Computus.gregorian_easter; transfer_target; readings } (* Empty by default: every check built before Task 12 exercises the |