(* of-litcal-layer task (2026-08-25): external validation of the OF rite module's Phase 1 temporal cycle (lib/rites/rite_of/temporal_of.ml) -- specifically the two-block Ordinary Time week arithmetic Normae n. 44 requires, named in .superpowers/sdd/of-phase1-report.md's own "Concerns" section as "the single highest-risk function in this phase", with NO external witness anywhere in Phase 1's own test suite. Witness: litcal (github.com/Liturgical-Calendar/LiturgicalCalendarAPI), Apache-2.0, already archived and SHA-256-pinned by the sibling project lectio. See test/fixtures/litcal-temporal-2024-2035.sexp's own header for the full provenance, the row-selection rules, and the SECOND-IMPLEMENTATION-NOT-SECOND-PUBLICATION caveat this layer is built under -- NOT repeated here. The season/week half below (unchanged since 2026-08-25) calls {!Rite_of.Temporal_of.temporal} directly, over the SAME civil-date window the fixture covers (2023-12-03..2035-12-01), no {!Colitur_kernel.Calendar}/{!Colitur_kernel.Layer} involved -- Phase 2 had not wired {!Colitur_kernel.Rite.t} yet when it was written. --------------------------------------------------------------------- TASK 6 EXTENSION (2026-08-26-colitur-of-phases-3-5, task 6): GRADE and IDENTITY. Phase 2/Task 5 have since assembled the real {!Rite_of.context} and a full shipped calendar, so this file now ALSO resolves every fixture date through {!Colitur_kernel.Calendar} (real data/of/calendar-2002.sexp + all 13 amendment overlays + the real lectionary, exactly {!Rite_of.context} as `colitur day --rite of` assembles it) and compares: - GRADE: litcal's own [grade_lcl] bucketed against the Tabula entry {!Rite_of.Precedence_of.band} assigns the day's OWN observed celebration (reconstructed as a candidate exactly the way {!Colitur_kernel.Validate.run}'s own "admission" check already does -- see [band_of] below). Covers every row EXCEPT three structurally uninformative classes, each named and counted, never silently skipped -- see [expected_bands]'s own comment. - IDENTITY: colitur's own observed [slug] against a HAND-VERIFIED [event_key -> slug] table (every entry checked against data/of/calendar-2002.sexp or temporal_of.ml directly before being typed in -- the same "checked before being typed in" discipline test_golden.ml's own header states for its pins), scoped DELIBERATELY NARROWER than grade -- see [identity_map]'s own comment for exactly what is and is not attempted and why. Both follow the SAME counted-and-allow-listed discipline L1 already established for season: a divergence not covered by an allow-list entry fails the suite outright ("zero unexplained"); a row this layer cannot meaningfully compare is counted under its own name, never silently dropped -- the EF oracle layer's own [Comm_identity_unresolved] precedent (CLAUDE.md's "know what each layer cannot see" section). *) module V = Rite_of.Vocab_of module T = Rite_of.Temporal_of module D = Colitur_kernel.Date module Layer = Colitur_kernel.Layer module Overlay = Colitur_kernel.Overlay module Cal = Colitur_kernel.Calendar module LD = Colitur_kernel.Liturgical_day module Slug = Colitur_kernel.Slug module Cel = Colitur_kernel.Celebration module Prec = Colitur_kernel.Precedence let fixture_path = "fixtures/litcal-temporal-2024-2035.sexp" let allow_list_path = "../data/of/expected-divergences-litcal.sexp" (* Duplicated, not shared -- every other Ordo/oracle test file in this project carries its own identical copy for the same reason (test_fiuv_ordo.ml's own comment): no .mli any of them could share it through. *) let sha256_of_file path = let tmp = Filename.temp_file "colitur_litcal_of_sha256" ".txt" in Fun.protect ~finally:(fun () -> try Sys.remove tmp with Sys_error _ -> ()) (fun () -> let cmd = Printf.sprintf "sha256sum %s > %s" (Filename.quote path) (Filename.quote tmp) in let rc = Sys.command cmd in if rc <> 0 then Alcotest.failf "sha256sum exited %d for %s (is it on PATH?)" rc path; let ic = open_in tmp in let line = try input_line ic with End_of_file -> close_in ic; Alcotest.failf "sha256sum produced no output for %s" path in close_in ic; match String.index_opt line ' ' with | Some i -> String.sub line 0 i | None -> Alcotest.failf "unexpected sha256sum output for %s: %S" path line) let fixture_sha256 = "f5d65b33ac1afd2a6d1d8e053d9c8897a24ffcc67136e73f0978189f02dae816" (* ---------------------------------------------------------------------- *) (* The litcal side: the sexp row, mirroring tools/extract_litcal_ordo.py's *) (* own [build_rows] output row-for-row. *) (* ---------------------------------------------------------------------- *) open Sexplib0.Sexp_conv type litcal_row = { date : string; season : string; ot_week : int option; event_key : string; grade_lcl : string } [@@deriving sexp] let litcal_rows () = let sexp = try Sexplib.Sexp.load_sexp fixture_path with e -> Alcotest.failf "%s: failed to load: %s" fixture_path (Printexc.to_string e) in list_of_sexp litcal_row_of_sexp sexp let window_first = "2023-12-03" let window_last = "2035-12-01" (* ---------------------------------------------------------------------- *) (* The colitur side, over the identical window -- straight [Temporal_of. *) (* temporal] calls, no Rite.t/Calendar involved (Phase 1 has neither). *) (* ---------------------------------------------------------------------- *) type colitur_row = { c_date : string; c_season : V.season; c_ot_week : int option } let colitur_rows () = let mk s = match D.of_iso8601 s with Ok d -> d | Error e -> Alcotest.failf "%s: %s" s e in let rows = ref [] in let d = ref (mk window_first) in let stop = mk window_last in while D.compare !d stop <= 0 do let temporal = T.temporal !d in rows := { c_date = D.to_iso8601 !d; c_season = temporal.Colitur_kernel.Temporal.season; c_ot_week = temporal.Colitur_kernel.Temporal.week } :: !rows; d := D.add_days !d 1 done; List.rev !rows (* litcal's own [liturgical_season] atom (lowercased by the generator) -> the [Vocab_of.season] it should equal, or [None] for ["easter_triduum"] -- a season colitur's own vocabulary has NO value for at all (temporal_of.ml's own top-of-module comment; see this task's own fixture header). [None] is not "unmapped/unknown": it is the signal that this row belongs to the Triduum allow-list class below, never silently skipped. *) let expected_season = function | "advent" -> Some V.Advent | "christmas" -> Some V.Christmas | "lent" -> Some V.Lent | "easter" -> Some V.Easter | "ordinary_time" -> Some V.Ordinary_time | "easter_triduum" -> None | s -> Alcotest.failf "unrecognised litcal season atom in fixture: %S" s (* ---------------------------------------------------------------------- *) (* data/of/expected-divergences-litcal.sexp -- same shape as every other *) (* allow-list in this project (test_fiuv_ordo.ml's own [allow_entry]). *) (* ---------------------------------------------------------------------- *) type allow_entry = { id : string; citation : string; verdict : string; note : string; expected_rows : int } [@@deriving sexp] let load_allow_list () = let sexps = try Sexplib.Sexp.load_sexps allow_list_path with e -> Alcotest.failf "%s: failed to load: %s" allow_list_path (Printexc.to_string e) in List.map allow_entry_of_sexp sexps (* L1 -- the only season-divergence class this layer expects: every EASTER_TRIDUUM-tagged litcal row (Holy Thursday's own evening Mass, Good Friday, Holy Saturday -- see the fixture header for why the Chrism Mass row is excluded upstream, in the generator, rather than here). *) let is_l1_triduum (r : litcal_row) = String.equal r.season "easter_triduum" (* ---------------------------------------------------------------------- *) (* Task 6: the real, resolved OF calendar -- the same assembly bin/main.ml's *) (* [load_of_layer]/[resolved_of_year_days] and test_rite_of.ml's own *) (* [real_of_layer]/[real_of_rite] perform. Duplicated rather than shared, *) (* the same discipline every Ordo/oracle test file in this project already *) (* states for itself (this file's own [sha256_of_file] comment, above): no *) (* .mli any of them could share it through. *) (* ---------------------------------------------------------------------- *) let calendar_path = "../data/of/calendar-2002.sexp" let amendments_dir = "../data/of/amendments/" let of_lectionary_path = "../data/of/lectionary.sexp" let amendment_files = [ "001-padre-pio.sexp"; "002-juan-diego-cuauhtlatoatzin.sexp"; "003-our-lady-of-guadalupe.sexp"; "004-john-xxiii-john-paul-ii.sexp"; "005-mary-magdalene-rank.sexp"; "006-mary-mother-of-the-church.sexp"; "007-paul-vi.sexp"; "008-our-lady-of-loreto.sexp"; "009-faustina-kowalska.sexp"; "010-narek-avila-hildegard.sexp"; "011-martha-mary-lazarus.sexp"; "012-teresa-of-calcutta.sexp"; "013-john-henry-newman.sexp" ] let real_of_layer = let base = match Layer.load V.rank_of_sexp calendar_path with | Ok l -> l | Error e -> Alcotest.failf "%s: failed to load: %s" calendar_path e in let overlays = List.map (fun name -> let path = amendments_dir ^ name in match Overlay.load V.rank_of_sexp path with | Ok o -> o | Error e -> Alcotest.failf "%s: failed to load: %s" path e) amendment_files in let layer, diagnostics = Overlay.merge base overlays in if diagnostics <> [] then Alcotest.failf "unexpected amendment diagnostics: %s" (String.concat "; " (List.map Overlay.diagnostic_to_string diagnostics)); layer let real_of_lectionary = match Colitur_kernel.Lectionary.load of_lectionary_path with | Ok l -> l | Error e -> Alcotest.failf "%s: failed to load: %s" of_lectionary_path e let real_of_rite = Rite_of.context ~lectionary:real_of_lectionary (* Every fixture date resolved once, indexed by rata die -- civil years 2022..2036 comfortably bracket the fixture's own 2023-12-03..2035-12-01 span with slack at both edges ({!Colitur_kernel.Calendar.year}'s own [y] covers Advent of civil year [y] through the following November, so [y] itself does not line up with the fixture's own civil-date window without this margin). Built once at module init, same reasoning test_validate.ml's own [real_ef_layer] gives: every test below reads it, and resolving 15 liturgical years once is far cheaper than resolving one per lookup. *) let resolved_index = let tbl : (int, (V.season, V.rank) LD.t) Hashtbl.t = Hashtbl.create 5000 in for y = 2022 to 2036 do Array.iter (fun (d : (V.season, V.rank) LD.t) -> Hashtbl.replace tbl (D.to_rata d.LD.date) d) (Cal.year real_of_rite real_of_layer y) done; tbl let resolved_of iso = let d = match D.of_iso8601 iso with Ok d -> d | Error e -> Alcotest.failf "%s: %s" iso e in match Hashtbl.find_opt resolved_index (D.to_rata d) with | Some day -> day | None -> Alcotest.failf "%s: not resolved -- outside [resolved_index]'s own civil-year margin" iso (* [band_of]: the Tabula entry (x10) colitur's OWN band function assigns the day's observed celebration -- NOT re-derived from [rank]/[subject] by hand here (that would silently drift from precedence_of.ml's own table the moment a branch there changed), but computed by calling {!Rite_of.Precedence_of.band} itself, exactly the way {!Colitur_kernel.Validate.run}'s own "admission" check reconstructs a candidate from a resolved {!Colitur_kernel.Liturgical_day.t} (that function's own comment is the citation for the origin-recovery technique reused here): a commemoration whose slug matches the day's own temporal office is temporal-origin, everything else is sanctoral-origin -- exact whenever slugs cannot collide across the two streams, the same assumption the rest of this codebase already leans on. *) let band_of (day : (V.season, V.rank) LD.t) = let t = day.LD.temporal in let temporal_slug = t.Colitur_kernel.Temporal.office.Cel.slug in let observed = day.LD.observed in let origin = if Slug.equal observed.Cel.slug temporal_slug then Prec.Temporal else Prec.Sanctoral in let cand : V.rank Prec.candidate = { Prec.cel = observed; origin } in let ctx : V.season Prec.context = { Prec.date = day.LD.date; season = t.Colitur_kernel.Temporal.season; weekday = t.Colitur_kernel.Temporal.weekday } in Rite_of.Precedence_of.band ctx cand (* litcal's own [grade_lcl] text, bucketed to the set of Tabula band values ({!Rite_of.Precedence_of.band}'s own x10 scale) that grade can legitimately correspond to on colitur's side -- verified against precedence_of.ml's own band branches, not guessed from the grade word alone: - "SOLEMNITY" -> Tabula I.3/I.4 (30/40) - "celebration with precedence over solemnities" (litcal's own text for Tabula I.1/I.2: the Triduum, the Nativity, Epiphany, Ascension, Pentecost, Ash Wednesday, the privileged Sundays of Advent/Lent/Easter, the Holy Week ferias, the Easter Octave) -> Tabula I.1/I.2 (10/20) - "FEAST OF THE LORD" (a Feast of the Lord, Tabula II.5, AND an ordinary Sunday of Christmas/Ordinary Time, Tabula II.6 -- litcal's own grade text does not distinguish the two; neither does this bucket) -> Tabula II.5/II.6 (50/60) - "FEAST" -> Tabula II.7/II.8 (70/80) - "Memorial" -> Tabula III.10/III.11 (100/110) THREE classes are DELIBERATELY [None] here -- not silently dropped, see [test_grade_unresolved_is_counted] below for why each is uninformative rather than merely unbuilt: - "weekday": litcal's own [pick_representative] (the fixture generator, tools/extract_litcal_ordo.py) ALWAYS prefers an Ord*/AdventWeekday/ LentWeekday/etc. row over a CO-LISTED optional memorial on the same date (its own docstring, "prefers the Ord* row; else the lowest- event_idx row that is not an 'optional memorial'"). colitur's own Precedence_of.band gives an optional memorial (Tabula III.12, band 120) a LOWER band than an ordinary feria (Tabula III.13, band 130) -- lower wins -- so on any date litcal tags "weekday" that ALSO happens to carry an unlisted optional memorial, colitur legitimately elects that memorial as its own observed day (Task 6 brief's self-review: "this plan models an unelected optional memorial as an ordinary loser (Omit)" -- the COMPLEMENT, an ELECTED one, becomes the day's own [observed]). Whether that unlisted memorial exists on any given "weekday" date is exactly the information [pick_representative] discards, so a "weekday" row's own grade is uninformative for this comparison, not merely inconvenient -- comparing it would manufacture spurious mismatches out of a fixture-generation choice, not a real divergence. - "optional memorial": the 5 rows [pick_representative]'s own third, rarer shape produces (two co-listed optional memorials, no weekday row at all, all five in the Immaculate-Heart-of-Mary window -- this file's own header/the generator's own comment) -- which of the two litcal's picker names is itself acknowledged upstream as arbitrary (lowest [event_idx]), so it carries no comparable claim about which one, if either, colitur elects. - Triduum rows are excluded a level up, by the caller, via [is_l1_triduum] -- see [test_grade_matches_or_is_explained]'s own comment for why this reuses L1's own reasoning rather than duplicating it. *) let expected_bands = function | "SOLEMNITY" -> Some [ 30; 40 ] | "celebration with precedence over solemnities" -> Some [ 10; 20 ] | "FEAST OF THE LORD" -> Some [ 50; 60 ] | "FEAST" -> Some [ 70; 80 ] | "Memorial" -> Some [ 100; 110 ] | "weekday" | "optional memorial" -> None | g -> Alcotest.failf "unrecognised litcal grade_lcl: %S" g (* [identity_map]: [event_key -> colitur slug], HAND-VERIFIED against data/of/calendar-2002.sexp (`grep -n "((slug " data/of/calendar-2002.sexp`, one date/slug pair confirmed per entry before it was typed in below) or lib/rites/rite_of/temporal_of.ml directly for the CODE-computed entries (the Sundays/named movable days), never copied from a `colitur day` run -- test_golden.ml's own header states the identical discipline for its pins, and it is followed here for the same reason. DELIBERATELY NARROWER than [expected_bands]'s own grade coverage, and this is a real, stated scope limit, not an oversight: every event_key mapped below is a FIXED, uniquely-named entity (a solemnity, a Feast of the Lord, a universal Feast of an apostle/evangelist, or a fixed/movable NAMED day -- Ascension, Ash Wednesday, the Nativity, Corpus Christi, Easter Sunday itself, Epiphany, Palm Sunday, Pentecost, Trinity Sunday). The NUMBERED series litcal's own event_keys also carry -- Advent1..Advent4, Lent1..Lent5, Easter2..Easter7, every OrdSundayN, and the Holy Week/Easter Octave weekday events (MonHolyWeek, TueOctaveEaster, etc.) -- are NOT individually mapped here. Building and hand-verifying a slug for each of those would mean re-deriving colitur's own week-numbered slug PATTERN (["of-%s-sunday-%d"]/["of-%s-%d-%s"], temporal_of.ml) by hand for every one of ~185 rows, which is exactly the arithmetic Step 1's own dedicated Ordinary-Time-week-bounds property and [Validate]'s own ["week"] check already verify structurally, at far lower risk of a transcription error than a hand-built parallel slug table would carry. Left [None] here -- counted under [test_identity_unresolved_is_counted] below as "patterned/numbered series, not individually name-mapped", a real, deliberate, counted scope limit, not a silent gap -- the same discipline the EF oracle layer's own [Comm_identity_unresolved] follows, scoped narrower here (to the closed FIXED/NAMED set) rather than to a SANCTORAL-origin/TEMPORAL-origin split, since here it is the fixture's own vocabulary (a compact internal key, not a title) rather than the celebration's origin that limits what a mapping can safely attempt. *) let identity_map = [ (* Tabula I.3, universal solemnities. *) ("AllSaints", "all-saints"); ("AllSouls", "all-souls"); ("Annunciation", "annunciation-of-the-lord"); ("Assumption", "assumption-of-the-blessed-virgin-mary"); ("ChristKing", "of-christ-the-king"); ("ImmaculateConception", "immaculate-conception-of-the-blessed-virgin-mary"); ("MaryMotherOfGod", "of-mary-mother-of-god"); ("NativityJohnBaptist", "birth-of-saint-john-the-baptist"); ("SacredHeart", "sacred-heart-of-jesus"); ("StJoseph", "joseph-husband-of-the-blessed-virgin-mary"); ("StsPeterPaulAp", "saints-peter-and-paul-apostles"); (* Tabula I.2, fixed/named days (CODE, temporal_of.ml's own [named]). *) ("Ascension", "of-ascension"); ("AshWednesday", "of-ash-wednesday"); ("Christmas", "of-nativity"); ("CorpusChristi", "of-corpus-christi"); ("Easter", "of-easter-sunday"); ("Epiphany", "of-epiphany"); ("PalmSun", "of-palm-sunday"); ("Pentecost", "of-pentecost"); ("Trinity", "of-trinity"); (* Tabula II.5, Feasts of the Lord. *) ("BaptismLord", "of-baptism-of-the-lord"); ("Christmas2", "of-christmas-sunday-2"); ("DedicationLateran", "dedication-of-the-lateran-basilica"); ("ExaltationCross", "triumph-of-the-holy-cross"); ("HolyFamily", "of-holy-family"); ("Presentation", "presentation-of-the-lord"); ("Transfiguration", "transfiguration-of-the-lord"); (* Tabula II.7, universal Feasts (apostles, evangelists, and similar). *) ("ChairStPeter", "chair-of-saint-peter-apostle"); ("ConversionStPaul", "the-conversion-of-saint-paul-apostle"); ("HolyInnocents", "holy-innocents-martyrs"); ("NativityVirginMary", "birth-of-the-blessed-virgin-mary"); ("StAndrewAp", "andrew-the-apostle"); ("StBartholomewAp", "bartholomew-the-apostle"); ("StJamesAp", "james-apostle"); ("StJohnEvangelist", "john-the-apostle-and-evangelist"); ("StLawrenceDeacon", "lawrence-deacon-and-martyr"); ("StLukeEvangelist", "luke-the-evangelist"); ("StMarkEvangelist", "mark-the-evangelist"); ("StMatthewEvangelist", "matthew-the-evangelist-apostle-evangelist"); ("StMatthiasAp", "matthias-the-apostle"); ("StSimonStJudeAp", "simon-and-saint-jude-apostles"); ("StStephenProtomartyr", "stephen-the-first-martyr"); ("StThomasAp", "thomas-the-apostle"); ("StsArchangels", "saints-michael-gabriel-and-raphael-archangels"); ("StsPhilipJames", "saints-philip-and-james-apostles"); ("Visitation", "visitation-of-the-blessed-virgin-mary") ] let identity_tbl = let tbl = Hashtbl.create 64 in List.iter (fun (k, v) -> Hashtbl.replace tbl k v) identity_map; tbl (* ---------------------------------------------------------------------- *) (* Tests *) (* ---------------------------------------------------------------------- *) let test_fixture_checksum () = Alcotest.(check string) "fixture SHA-256 matches its provenance header" fixture_sha256 (sha256_of_file fixture_path) let test_dates_align () = let litcal = litcal_rows () in let colitur = colitur_rows () in Alcotest.(check int) "the fixture has 4382 rows (2023-12-03..2035-12-01)" 4382 (List.length litcal); Alcotest.(check int) "colitur resolved the same number of days" (List.length litcal) (List.length colitur); (match litcal with | l :: _ -> Alcotest.(check string) "first date" window_first l.date | [] -> Alcotest.fail "empty"); (match List.rev litcal with | l :: _ -> Alcotest.(check string) "last date" window_last l.date | [] -> Alcotest.fail "empty"); let mismatched = List.filter_map (fun (l, c) -> if String.equal l.date c.c_date then None else Some (l.date, c.c_date)) (List.combine litcal colitur) in Alcotest.(check (list (pair string string))) "no misaligned dates" [] mismatched (* The season comparison: every litcal row either matches colitur's own season outright, or is named in the allow-list (L1, the Triduum class) -- zero unexplained anywhere in the 4382-day window. *) let test_season_matches_or_is_explained () = let litcal = litcal_rows () in let colitur = colitur_rows () in let allow_list = load_allow_list () in let by_id = List.map (fun e -> (e.id, e)) allow_list in let unexplained = ref [] in let l1_count = ref 0 in List.iter2 (fun (l : litcal_row) (c : colitur_row) -> if not (String.equal l.date c.c_date) then Alcotest.failf "misaligned: litcal %s vs colitur %s" l.date c.c_date; match expected_season l.season with | None -> (* easter_triduum *) if is_l1_triduum l then incr l1_count else Alcotest.failf "%s: unrecognised no-mapping season %S" l.date l.season | Some expected -> if expected = c.c_season then () else unexplained := Printf.sprintf "%s: colitur season=%s, litcal season=%s (event_key=%S)" l.date (V.season_to_string c.c_season) l.season l.event_key :: !unexplained) litcal colitur; Alcotest.(check (list string)) "every season mismatch is named in the allow-list -- none unexplained" [] (List.rev !unexplained); (match List.assoc_opt "L1" by_id with | None -> Alcotest.failf "allow-list entry L1 is used by the comparator but not declared in %s" allow_list_path | Some e -> Alcotest.(check int) "L1 (Easter Triduum, no colitur season value) expected_rows" e.expected_rows !l1_count) (* No more "only L1 is used" check here: task 6 adds two more comparators (grade, identity) against this SAME allow-list file, each with their own ids. [test_allow_list_has_no_orphan_entries], at the end of this file, is the single place that now asserts the WHOLE file's own id set is exactly the union every comparator recognises -- one place, not three copies of a whole-file assertion that would only ever be right in one of them at a time. *) (* THE load-bearing test: the Ordinary Time week, on every day litcal actually witnesses one (an Ord* event_key present on that date) -- Normae n. 44's own two-block resumption arithmetic, the risk this whole layer exists to validate. Zero tolerance: every witnessed week must match exactly, with no allow-list at all -- a real mismatch here would mean colitur serves the WRONG MASS FORMULARY, not a cosmetic difference, so there is no "expected divergence" shape for this half of the comparison the way there is for season/Triduum. *) let test_ordinary_time_week_matches () = let litcal = litcal_rows () in let colitur = colitur_rows () in let mismatched = ref [] in let witnessed = ref 0 in List.iter2 (fun (l : litcal_row) (c : colitur_row) -> if not (String.equal l.date c.c_date) then Alcotest.failf "misaligned: litcal %s vs colitur %s" l.date c.c_date; match l.ot_week with | None -> () | Some n -> incr witnessed; if c.c_ot_week <> Some n then mismatched := Printf.sprintf "%s: colitur week=%s, litcal week=%d (event_key=%S, colitur season=%s)" l.date (match c.c_ot_week with Some w -> string_of_int w | None -> "None") n l.event_key (V.season_to_string c.c_season) :: !mismatched) litcal colitur; Alcotest.(check (list string)) "every witnessed Ordinary Time week matches exactly -- zero tolerance" [] (List.rev !mismatched); (* Pinned so a change in the fixture or the extraction rules is visible, not merely "still zero mismatches" -- the same discipline every count assertion in this project's other Ordo/oracle layers follows. *) Alcotest.(check int) "1876 of the 4382 days witness an Ordinary Time week" 1876 !witnessed (* The UNWITNESSED half of Ordinary Time, mirroring the EF module's own [Comm_identity_unresolved] precedent (CLAUDE.md's "know what each layer cannot see" section): NOT a mismatch (litcal has no answer to compare against on these days, an obligatory celebration having suppressed its own weekday/Sunday row), so NOT allow-listed -- but counted and classified rather than silently skipped. Two shapes, both named in the fixture's own header: (a) an obligatory celebration suppresses the weekday outright (by far the majority); (b) a handful of dates (the Immaculate-Heart-of-Mary window) where litcal's own data omits the weekday despite showing only optional-memorial-grade rows -- both collapse to the same "grade_lcl <> weekday" signal here, since the ONLY grade litcal ever gives an Ord* row is "weekday"/"FEAST OF THE LORD" (a Sunday) -- checked directly against the fixture's own content, not assumed. *) let test_unwitnessed_ordinary_time_is_counted () = let litcal = litcal_rows () in let unwitnessed = List.filter (fun (l : litcal_row) -> String.equal l.season "ordinary_time" && l.ot_week = None) litcal in Alcotest.(check int) "859 Ordinary Time days have no litcal-witnessed week" 859 (List.length unwitnessed); let by_grade = Hashtbl.create 8 in List.iter (fun (l : litcal_row) -> Hashtbl.replace by_grade l.grade_lcl (1 + try Hashtbl.find by_grade l.grade_lcl with Not_found -> 0)) unwitnessed; let total = Hashtbl.fold (fun _ n acc -> n + acc) by_grade 0 in Alcotest.(check int) "grade_lcl buckets sum to the same 859" 859 total (* ---------------------------------------------------------------------- *) (* Task 6: GRADE. Every non-Triduum row whose [grade_lcl] names an *) (* [expected_bands] bucket (i.e. every row except "weekday"/"optional *) (* memorial", see that function's own comment) is checked against *) (* {!band_of}'s own reconstruction of colitur's REAL, resolved observed *) (* day -- real data/of/calendar-2002.sexp + all 13 amendments, not a *) (* placeholder. *) (* ---------------------------------------------------------------------- *) (* Row-classifiers for the divergence classes found by actually RUNNING this comparator against real data (never guessed in advance) -- one predicate per allow-list id, shared between the grade and identity comparators where a class shows up in both (L6/L7, L8/L9 are the identity/grade halves of the SAME root cause, exactly as L2/L3 already are for Holy Family). Each is named for, and restricted to, the EXACT row(s) found; none is a loose pattern that could silently absorb an unrelated future mismatch. *) (* L2/L3 -- Normae n. 35(a), the Holy Family fallback: KNOWN WRONG, pinned (not fixed) by test_rite_of.ml's own [test_holy_family_fallback_1583_known_wrong_ferial]/ [is_known_holy_family_fallback_gap]. 30 December 2033 is this fixture's own live witness (2033: 25 December is a Sunday, so 26-31 December's own window has no Sunday of its own and {!Rite_of.Temporal_of.temporal} never reaches [holy_family]'s own fixed 30-December fallback branch). litcal correctly names ["HolyFamily"]; colitur observes an ordinary Nativity-octave feria (Tabula II.9, band 90) instead. *) let is_l2_l3_holy_family_2033 (l : litcal_row) = String.equal l.event_key "HolyFamily" && String.equal l.date "2033-12-30" (* L4 -- litcal's own [grade_lcl] "celebration with precedence over solemnities" text covers Trinity Sunday and Corpus Christi too (24 rows, every one of the fixture's 12 years), which precedence_of.ml's own Tabula I.2 transcription does NOT: "Nativitas Domini, Epiphania, Ascensio et Pentecostes; dominicae Adventus, Quadragesimae et Paschae; feria IV Cinerum; hebdomada sancta a feria II ad V" names neither -- both are "Sollemnitates Domini" (Tabula I.3, band 30), the SAME entry {!Rite_of.Precedence_of.band} gives ChristKing, a structurally identical "Solemnity of the Lord anchored to a Sunday within Ordinary Time" -- and litcal ITSELF labels ChristKing "SOLEMNITY", not this text (checked directly: ChristKing is one of this file's own [identity_map] entries and produces no grade mismatch anywhere in the fixture). That asymmetry is offered as corroborating evidence, not proof (this task did not inspect litcal's own source to confirm WHY), that litcal's own grade vocabulary is coarser/inconsistent here rather than a considered, different Tabula reading -- verdict "colitur". *) let is_l4_trinity_corpus_christi (l : litcal_row) = String.equal l.event_key "Trinity" || String.equal l.event_key "CorpusChristi" (* L5 -- litcal's own data is STALE: "StMaryMagdalene" grade_lcl reads "Memorial" on every one of the 10 years this fixture witnesses her (22 July; 2 of the 12 years have no witness at all, an ordinary per-annum Sunday there instead, on both sides -- not a mismatch). The 2016 CDW decree ("Sanctae Mariae Magdalenae", 3 June 2016, Prot. n. 708/2015, AAS 108 (2016) 798-799) raised her to FEAST -- colitur's own data/of/amendments/005-mary-magdalene-rank.sexp applies it (band 70, not 100/110); litcal's grade text shows no sign of applying it. Verdict "litcal". *) let is_l5_mary_magdalene (l : litcal_row) = String.equal l.event_key "StMaryMagdalene" (* L6/L7 -- a genuine, UNADJUDICATED tie-break, found live: Easter 2033 is 17 April, which puts the movable Solemnity of the Sacred Heart (Easter + 68) on 24 June, the SAME fixed date as the Nativity of St John the Baptist -- both Tabula I.3, band 30, an exact tie. {!Colitur_kernel.Precedence.resolve}'s own tie-break (precedence.ml's [compare_by], [Slug.compare] when bands are equal -- confirmed by reading that function directly, not inferred) hands the day to "birth-of-saint-john-the-baptist" alphabetically, and {!Rite_of.Precedence_of.disposition} then Transfers the loser (a losing Sollemnitas always is) to the next free day, landing Sacred Heart on 25 June. litcal's own answer is the OPPOSITE: it keeps Sacred Heart on its natural 24 June and instead shows "NativityJohnBaptist" a day EARLY, on 23 June (and its own Immaculate Heart of Mary, independently anchored at Easter + 69, is unaffected either way -- unwitnessed here since "ImmaculateHeart" carries no [identity_map] entry). NEITHER side's choice is dictated by any citation this task found: the Tabula's own text ranks both candidates at the identical entry, and nothing in the Normae or IGMR extracts a Solemnity-of-the-Lord-outranks-a- Solemnity-of-a-Saint rule WITHIN one Tabula entry the way, e.g., RG 112(a) does on the EF side for a narrower case. Verdict "open" -- genuinely unresolved, not attributed to either engine, and NOT fixed here (a kernel-level tie-break policy is out of this task's scope regardless). Two rows: [NativityJohnBaptist] (23 June) fails BOTH grade (colitur observes a plain feria there, band 130) and identity; [SacredHeart] (24 June) matches grade by coincidence (colitur's actual occupant, John Baptist, is ALSO Tabula I.3/band 30) but fails identity; [ImmaculateHeart] (25 June) fails grade only (colitur's actual occupant there, the transferred Sacred Heart, is band 30, not litcal's expected Memorial band). *) let is_l6_2033_tie_grade (l : litcal_row) = (String.equal l.event_key "NativityJohnBaptist" && String.equal l.date "2033-06-23") || (String.equal l.event_key "ImmaculateHeart" && String.equal l.date "2033-06-25") let is_l7_2033_tie_identity (l : litcal_row) = (String.equal l.event_key "NativityJohnBaptist" && String.equal l.date "2033-06-23") || (String.equal l.event_key "SacredHeart" && String.equal l.date "2033-06-24") (* L8/L9 -- a SECOND, newly-found instance of precedence_of.mli's own documented "KNOWN UNIMPLEMENTED FOURTH RULE" (Normae n. 60's "ad proximiorem diem" -- the NEAREST day, not necessarily the nearest FOLLOWING one -- constrained to forward-only search by {!Colitur_kernel.Rite.t.transfer_target}'s own strictly-later contract, an EF-shaped kernel obligation that mli section names and does not fix). That section's own worked example is St Joseph falling exactly ON Palm Sunday (Normae n. 56(f), anticipated to 18 March); this is a DIFFERENT date shape reaching the SAME underlying limitation: Easter 2035 is 25 March, putting St Joseph's fixed 19 March on the MONDAY of Holy Week (Easter - 6, a privileged Tabula I.2 feria, not a Sunday), so Normae n. 5's own "following Monday" rule (keyed to a privileged SUNDAY) does not apply here at all -- this falls straight to n. 60's general rule 3, forward-only on colitur's side, landing Joseph on 3 April (Easter + 9, the Tuesday of Easter's Second Week). litcal's own answer anticipates BACKWARD instead, to 17 March -- the Saturday immediately before Palm Sunday, a generalisation of n. 56(f)'s own underlying principle to a date this task found no primary-source text for -- offered as informative evidence of what a fix would need to produce, not as a citation substituting for one. Verdict "colitur" (a known kernel-level limitation, not proven wrong absent a primary-source ruling for THIS exact date shape) -- NOT fixed here, per this task's own brief. *) let is_l8_l9_joseph_2035 (l : litcal_row) = String.equal l.event_key "StJoseph" && String.equal l.date "2035-03-17" let test_grade_matches_or_is_explained () = let litcal = litcal_rows () in let allow_list = load_allow_list () in let by_id = List.map (fun e -> (e.id, e)) allow_list in let unexplained = ref [] in let checked = ref 0 in let counts = Hashtbl.create 8 in let bump id = Hashtbl.replace counts id (1 + try Hashtbl.find counts id with Not_found -> 0) in List.iter (fun (l : litcal_row) -> if is_l1_triduum l then () else match expected_bands l.grade_lcl with | None -> () | Some bands -> incr checked; let day = resolved_of l.date in let band = band_of day in if List.mem band bands then () else if is_l2_l3_holy_family_2033 l then bump "L2" else if is_l4_trinity_corpus_christi l then bump "L4" else if is_l5_mary_magdalene l then bump "L5" else if is_l6_2033_tie_grade l then bump "L6" else if is_l8_l9_joseph_2035 l then bump "L8" else unexplained := Printf.sprintf "%s: colitur band=%d, litcal grade=%S (event_key=%S, expected one of [%s])" l.date band l.grade_lcl l.event_key (String.concat "," (List.map string_of_int bands)) :: !unexplained) litcal; Alcotest.(check (list string)) "every grade mismatch is named in the allow-list -- none unexplained" [] (List.rev !unexplained); Alcotest.(check int) "1800 non-Triduum rows carry a grade this layer can compare" 1800 !checked; List.iter (fun id -> let actual = try Hashtbl.find counts id with Not_found -> 0 in match List.assoc_opt id by_id with | None -> Alcotest.failf "allow-list entry %s is used by the comparator but not declared in %s" id allow_list_path | Some e -> Alcotest.(check int) (Printf.sprintf "%s expected_rows (grade)" id) e.expected_rows actual) [ "L2"; "L4"; "L5"; "L6"; "L8" ] (* The complement, mirroring [test_unwitnessed_ordinary_time_is_counted]: every row [expected_bands] returns [None] for, classified by which of the two structurally-uninformative shapes it is (see [expected_bands]'s own comment for why each is uninformative rather than merely unbuilt), never silently dropped from the total. *) let test_grade_unresolved_is_counted () = let litcal = litcal_rows () in let non_triduum = List.filter (fun l -> not (is_l1_triduum l)) litcal in let weekday = List.filter (fun (l : litcal_row) -> String.equal l.grade_lcl "weekday") non_triduum in let optional = List.filter (fun (l : litcal_row) -> String.equal l.grade_lcl "optional memorial") non_triduum in Alcotest.(check int) "2541 weekday rows are uninformative for grade (see expected_bands)" 2541 (List.length weekday); Alcotest.(check int) "5 optional-memorial rows are uninformative for grade (see expected_bands)" 5 (List.length optional); Alcotest.(check int) "weekday + optional-memorial + the 1800 checked + 36 Triduum = 4382 total" 4382 (List.length weekday + List.length optional + 1800 + 36) (* ---------------------------------------------------------------------- *) (* Task 6: IDENTITY. Narrower than grade -- see [identity_map]'s own *) (* comment for exactly why. *) (* ---------------------------------------------------------------------- *) let test_identity_matches_or_is_explained () = let litcal = litcal_rows () in let allow_list = load_allow_list () in let by_id = List.map (fun e -> (e.id, e)) allow_list in let unexplained = ref [] in let checked = ref 0 in let counts = Hashtbl.create 8 in let bump id = Hashtbl.replace counts id (1 + try Hashtbl.find counts id with Not_found -> 0) in List.iter (fun (l : litcal_row) -> if is_l1_triduum l then () else match Hashtbl.find_opt identity_tbl l.event_key with | None -> () | Some expected_slug -> incr checked; let day = resolved_of l.date in let actual_slug = Slug.to_string day.LD.observed.Cel.slug in if String.equal actual_slug expected_slug then () else if is_l2_l3_holy_family_2033 l then bump "L3" else if is_l7_2033_tie_identity l then bump "L7" else if is_l8_l9_joseph_2035 l then bump "L9" else unexplained := Printf.sprintf "%s: colitur slug=%S, litcal event_key=%S (expected slug=%S)" l.date actual_slug l.event_key expected_slug :: !unexplained) litcal; Alcotest.(check (list string)) "every identity mismatch is named in the allow-list -- none unexplained" [] (List.rev !unexplained); Alcotest.(check int) "508 rows carry an event_key this layer individually name-maps" 508 !checked; List.iter (fun id -> let actual = try Hashtbl.find counts id with Not_found -> 0 in match List.assoc_opt id by_id with | None -> Alcotest.failf "allow-list entry %s is used by the comparator but not declared in %s" id allow_list_path | Some e -> Alcotest.(check int) (Printf.sprintf "%s expected_rows (identity)" id) e.expected_rows actual) [ "L3"; "L7"; "L9" ] (* The complement: every row [identity_map] has no entry for, whether because litcal names an event_key outside the closed FIXED/NAMED set this layer maps (the numbered series -- see [identity_map]'s own comment) or because the row's own grade is one of grade's own two uninformative shapes (a "weekday"/"optional memorial" row never names an event_key this table maps, checked directly below, not assumed) or is the day's own Feast/Memorial that this layer does not individually name-map at all (the bulk of the residue: 189 FEAST + 668 Memorial rows, most of whose event_keys are simply not in [identity_map]). Counted, never silently skipped. *) let test_identity_unresolved_is_counted () = let litcal = litcal_rows () in let non_triduum = List.filter (fun l -> not (is_l1_triduum l)) litcal in let unresolved = List.filter (fun (l : litcal_row) -> not (Hashtbl.mem identity_tbl l.event_key)) non_triduum in Alcotest.(check int) "3838 non-Triduum rows carry no individually name-mapped event_key" 3838 (List.length unresolved); Alcotest.(check int) "unresolved + the 508 checked = 4346 non-Triduum rows" 4346 (List.length unresolved + 508) (* ---------------------------------------------------------------------- *) (* The whole allow-list file, taken as a whole: every id it declares is *) (* recognised by exactly one comparator above (L1 season, L2 grade, L3 *) (* identity) -- no orphan entry a comparator no longer references, and no *) (* comparator silently reading an id this file does not declare (each *) (* comparator's own [List.assoc_opt] already fails loudly for that half). *) (* ---------------------------------------------------------------------- *) let recognized_allow_ids = [ "L1"; "L2"; "L3"; "L4"; "L5"; "L6"; "L7"; "L8"; "L9" ] let test_allow_list_has_no_orphan_entries () = let allow_list = load_allow_list () in let declared = List.sort compare (List.map (fun e -> e.id) allow_list) in Alcotest.(check (list string)) "every declared id is recognised by a comparator, and vice versa" (List.sort compare recognized_allow_ids) declared let suite = ( "litcal-of", [ Alcotest.test_case "fixture checksum" `Quick test_fixture_checksum; Alcotest.test_case "dates align" `Quick test_dates_align; Alcotest.test_case "season matches or is explained" `Quick test_season_matches_or_is_explained; Alcotest.test_case "Ordinary Time week matches exactly where witnessed" `Quick test_ordinary_time_week_matches; Alcotest.test_case "unwitnessed Ordinary Time is counted, not skipped" `Quick test_unwitnessed_ordinary_time_is_counted; Alcotest.test_case "grade matches or is explained" `Quick test_grade_matches_or_is_explained; Alcotest.test_case "grade-unresolved rows are counted, not skipped" `Quick test_grade_unresolved_is_counted; Alcotest.test_case "identity matches or is explained" `Quick test_identity_matches_or_is_explained; Alcotest.test_case "identity-unresolved rows are counted, not skipped" `Quick test_identity_unresolved_is_counted; Alcotest.test_case "allow-list has no orphan entries" `Quick test_allow_list_has_no_orphan_entries ] )