diff options
Diffstat (limited to 'test/test_lms_ordo.ml')
| -rw-r--r-- | test/test_lms_ordo.ml | 821 |
1 files changed, 414 insertions, 407 deletions
diff --git a/test/test_lms_ordo.ml b/test/test_lms_ordo.ml index a728cbc..84c4776 100644 --- a/test/test_lms_ordo.ml +++ b/test/test_lms_ordo.ml @@ -1,112 +1,88 @@ -(* Task 6 (2026-08-21-colitur-celebrant-rubrics-phase1): validation layer 6 - -- the Latin Mass Society's own printed Ordo for England & Wales - (test/fixtures/lms-ordo-2024-2025.sexp; that file's own provenance - header carries the full source citation, SHA-256 and the - characterisation record demanded before trusting a single row of it). +(* Task 6 (2026-08-21-colitur-celebrant-rubrics-phase1) built this layer + against ONE LMS Ordo edition (2024-2025). The Witnesses task + (2026-08-22, same phase) extends it to THREE editions -- 2023-2024, + 2024-2025, 2025-2026 -- each compared in its OWN window, counted and + reported SEPARATELY, never merged: a divergence appearing in one year + and not another is informative on its own, and merging would hide it. + [make_suite] below is the shared machinery Task 6 built as a single + flat file; every per-year fact that Task 6 hardcoded (window dates, + fixture SHA-256, the "only Good Friday has no Creed marker" pin, the + formulary-bucket totals, the BVM-Saturday population) is now a + parameter or a value RE-DERIVED from the rubric independently per + window, not copied forward -- see each call site below for the + per-edition numbers, which do differ (397/399/400 rows; not every + edition even has the same II-class "sharp pairing" saint available, + see [fixture_probes] in tools/extract_lms_ordo.ml's own header for + 2025-2026's own Joachim-is-impeded finding). WHY THIS LAYER EXISTS, AND WHAT IT IS INDEPENDENT OF: layers 3-4 (test_differential.ml, test_oracle.ml) are ONE LINEAGE running Divinum Officium -> missalemeum -> lectio -> colitur (CLAUDE.md's "know what each layer cannot see" section); layer 5 (test_golden.ml) pins colitur's own output against itself. This Ordo is compiled independently by the - Latin Mass Society (a printed book, ISBN 9781739209636, England & Wales - diocesan propers) from the 1962 Missal/1960 rubrics directly -- it never - passed through Divinum Officium, missalemeum or lectio at any point, so - an error inherited by that whole lineage (colitur's own bootstrap - included) is visible here for the first time. + Latin Mass Society (a printed book, England & Wales diocesan propers) + from the 1962 Missal/1960 rubrics directly -- it never passed through + Divinum Officium, missalemeum or lectio at any point, so an error + inherited by that whole lineage (colitur's own bootstrap included) is + visible here for the first time. Three editions of the SAME publisher's + book are still only ONE compiler's judgement (see docs/research/ordo/ + PROVENANCE-ordo-corpus.md's own "what this corpus still cannot show" -- + genuine cross-compiler independence needs the FIUV layer, test_fiuv_ + ordo.ml, built separately in this same task). SCOPE, decided after running the comparison against real data (not - guessed in advance -- see the fixture's own CHARACTERISATION section - and task-6-report.md for the measurements this scoping rests on): + guessed in advance -- see each fixture's own CHARACTERISATION section): - The CREED (RG 475-476, {!Rite_ef.Rubrics_ef.creed}): compared on - every day, full 1:1. One genuine day is EXCLUDED, not silently - skipped: 2025-04-18 (Good Friday) has no Mass in the 1955-restored - Holy Week, so the Ordo prints no Gl/Cr line at all -- [test_ - creed_coverage] asserts this is the ONLY such day, so a future - parsing regression that swallowed a real row would fail loudly - here, not slip into "explained" silently. + every day, full 1:1, in every edition's own window. Exactly one day + per window is EXCLUDED, not silently skipped: that window's own + Good Friday (RE-DERIVED per window from {!Colitur_kernel.Computus. + gregorian_easter}, never hardcoded to a specific date) has no Mass + in the 1955-restored Holy Week, so the Ordo prints no Gl/Cr line at + all there -- [test_creed_coverage] asserts this is the ONLY such + day per window. - The BVM-SATURDAY SEASONAL SELECTION (RG 309(a), "iuxta temporum diversitatem", {!Rite_ef.Lectionary_ef.bvm_saturday_citations}): - the coordinator addendum's own "sharper check" -- the Ordo's own - roman numeral (I-V) names WHICH of the five seasonal "Missae de - sancta Maria in sabbato" is said, so it validates colitur's - SEASONAL SELECTION, not merely that some BVM Mass was chosen. - Built, because the extraction supports it (whole-line anchored - match against all five, see the fixture header on why substring - matching is wrong): every {!Colitur_kernel.Mass_formulary.Votive} - day inside the fixture's own 2024-11-27..2025-12-31 window is - checked against the numeral's implied season. + the Ordo's own roman numeral (I-V) names WHICH of the five seasonal + "Missae de sancta Maria in sabbato" is said, so it validates + colitur's SEASONAL SELECTION, not merely that some BVM Mass was + chosen. Checked against every {!Colitur_kernel.Mass_formulary. + Votive} day inside each edition's own window. - The FORMULARY OVERRIDE (does the day say its own Mass, or a borrowed one) -- compared for THREE of {!Colitur_kernel. - Mass_formulary.source}'s five constructors, each independently - 100% clean against the real fixture: - [Proper] (179 of 400 days): the Ordo shows NO "Mass of ..." line. - [Preceding_sunday] (66 of 400): the Ordo ALWAYS shows one. - [Common] (2 of 400): the Ordo shows NO "Mass of ..." line either - -- a Common-routed saint (ubaldus, didacus) still keeps his OWN - title in the Ordo, borrowing only the Common's PREFACE ("Common - Pr" on the title line itself), never a separate override line. - [Votive] is covered by the BVM check above instead (its own - override line IS the roman-numeral line). - [Own_slug] (139 of 400) is DELIBERATELY EXCLUDED from this axis, - not silently -- a real, evidenced data-representation fact, not a - guess: 11 of its 139 days DO show a "Mass of ..." override - ("2nd Sunday of Advent", "the Epiphany", "1st Sunday after - Pentecost"), because data/ef/lectionary.sexp carries some ferial - slugs (e.g. [ef-advent-2-monday]) as an EXPLICIT entry whose - citations are byte-identical to the following Sunday's own - ([ef-advent-sunday-2]: both "Rom 15:4-13" / "Matt 11:2-10" -- - checked directly against the shipped data), rather than resolving - through the {!Colitur_kernel.Mass_formulary.Preceding_sunday} - fallback path. Both representations name the SAME texts -- this is - a provenance-field ambiguity in colitur's own data, not a rubric - question the Ordo could adjudicate either way, so asserting on it - would manufacture exactly the kind of false divergence the - coordinator addendum's "collapsed to ~0 real ones" warning is - about. Recorded here rather than dropped silently, per the task - brief's own instruction for exactly this situation. + Mass_formulary.source}'s five constructors ([Proper]/ + [Preceding_sunday]/[Common]), on the same [Own_slug]-excluded, + [Votive]-covered-separately basis Task 6 established (see that + task's own report for the full reasoning: 11 of [Own_slug]'s + real days show an Ordo override anyway, a data-representation + ambiguity in colitur's own lectionary, not a rubric question the + Ordo could adjudicate). - GLORIA is extracted into the fixture (a genuine, independently useful + GLORIA is extracted into every fixture (a genuine, independently useful field for the still-unbuilt Phase 2 Gloria rule) but NOT compared here: - colitur has no {!Rite_ef.Rubrics_ef}-level Gloria predicate yet (the - design doc defers it explicitly), so there is nothing on colitur's own - side to compare it against. Comparing it would be comparing the Ordo - against nothing. + colitur has no {!Rite_ef.Rubrics_ef}-level Gloria predicate yet. DIOCESAN SCOPE: colitur computes the UNIVERSAL General Roman Calendar only (no diocesan overlay loaded by the differential/oracle harnesses - anywhere in this suite) -- the Ordo is an England & Wales diocesan - Ordo, and 156 of its 400 days (39%) carry at least one diocesan - variant. Every comparison in this file reads ONLY the fixture's own - universal-block fields ([formulary_override], [bvm_numeral], [gloria], - [creed] are all derived from the text BEFORE the first diocese-list - line -- see extract_lms_ordo.ml's own [scan_block]); the diocesan text - itself is never read at all, only its PRESENCE is recorded - ([has_diocesan_variant]), so no diocesan variant can leak into a - comparison here by construction, not merely by care. *) + anywhere in this suite) -- every LMS edition is an England & Wales + diocesan Ordo, and each fixture's own provenance header quantifies how + many of its days carry at least one diocesan variant. Every comparison + in this file reads ONLY each fixture's own universal-block fields. *) module Cal = Colitur_kernel.Calendar module Layer = Colitur_kernel.Layer module Overlay = Colitur_kernel.Overlay module LD = Colitur_kernel.Liturgical_day module Date = Colitur_kernel.Date +module Computus = Colitur_kernel.Computus module MF = Colitur_kernel.Mass_formulary module V = Rite_ef.Vocab_ef module TE = Rite_ef.Temporal_ef let sanctoral_path = "../data/ef/sanctoral.sexp" let adjustments_path = "../data/ef/adjustments.sexp" -let fixture_path = "fixtures/lms-ordo-2024-2025.sexp" -let allow_list_path = "../data/ef/expected-divergences-lms.sexp" - -(* Asserted, not merely documented -- test_oracle.ml's own [fixture_sha256] - comment explains why: a hand-edit or partial re-extraction would - otherwise silently turn the oracle into an unlabelled snapshot of - whatever someone last ran. Matches the fixture's own provenance header. *) -let fixture_sha256 = "da817b75c5bf40ed3be1d5f6890b199705e02ce4d42111253ab8547bccabc3f7" (* Duplicated, not shared, from test_oracle.ml/test_differential.ml's own identical function -- neither file exposes an .mli the other could @@ -176,23 +152,20 @@ type ordo_row = { } [@@deriving sexp] -let ordo_rows () = +let ordo_rows fixture_path = 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 ordo_row_of_sexp sexp -(* The fixture's own real window -- 2024-11-27 ("End of November 2024") - through 2025-12-31 (the day before the extractor's own stop marker). - 400 = 4 (27-30 Nov 2024) + 31 (Dec 2024) + 365 (2025, not a leap year). *) -let window_first = "2024-11-27" -let window_last = "2025-12-31" - (* ---------------------------------------------------------------------- *) -(* The colitur side, over the same window. Mirrors test_oracle.ml's own *) -(* [colitur_rows]: the resolution walk starts a year EARLY because a *) -(* liturgical year is Advent-anchored and straddles two civil years. *) +(* The colitur side, over the SAME window a given fixture covers. Mirrors *) +(* test_oracle.ml's own [colitur_rows]: the resolution walk starts a civil *) +(* year EARLY (and ends one late) because a liturgical year is *) +(* Advent-anchored and straddles two civil years -- generalised from Task *) +(* 6's single hardcoded [2023..2025] to a [~year_lo]/[~year_hi] parameter *) +(* per window, since the three editions' own civil-year spans differ. *) (* ---------------------------------------------------------------------- *) type colitur_row = { @@ -202,18 +175,20 @@ type colitur_row = { c_creed : bool; } -let colitur_rows () = +let colitur_rows ~year_lo ~year_hi ~window_first ~window_last = let layer = real_layer () in let rite = Rite_ef.context ~lectionary:(real_lectionary ()) ~commons:(real_commons ()) in let by_rata : (int, (V.season, V.rank) LD.t) Hashtbl.t = Hashtbl.create 800 in - for y = 2023 to 2025 do + for y = year_lo to year_hi do let days = Cal.year rite layer y in Array.iter (fun (d : (V.season, V.rank) LD.t) -> Hashtbl.replace by_rata (Date.to_rata d.LD.date) d) days done; - let mk y m d = match Date.make ~year:y ~month:m ~day:d with Ok t -> t | Error e -> failwith e in + let mk s = + match Date.of_iso8601 s with Ok d -> d | Error e -> Alcotest.failf "%s: not a valid ISO-8601 date: %s" s e + in let rows = ref [] in - let d = ref (mk 2024 11 27) in - let stop = mk 2025 12 31 in + let d = ref (mk window_first) in + let stop = mk window_last in while Date.compare !d stop <= 0 do (match Hashtbl.find_opt by_rata (Date.to_rata !d) with | Some day -> @@ -228,11 +203,7 @@ let colitur_rows () = (* ---------------------------------------------------------------------- *) (* RG 309(a), "iuxta temporum diversitatem" -- INDEPENDENTLY re-derived *) -(* from the rubric, not called from Lectionary_ef.bvm_saturday_citations *) -(* (private to that .ml, no .mli export, and re-deriving here is itself *) -(* the more useful check: importing colitur's own function would make *) -(* this axis tautological). Mirrors that function's own season match *) -(* exactly -- see its citation in lectionary_ef.ml for the scan lines. *) +(* from the rubric, not called from Lectionary_ef.bvm_saturday_citations. *) (* ---------------------------------------------------------------------- *) let expected_bvm_numeral season ~month ~day = @@ -246,13 +217,16 @@ let expected_bvm_numeral season ~month ~day = (* ---------------------------------------------------------------------- *) (* data/ef/expected-divergences-lms.sexp -- same shape as *) -(* test_oracle.ml's own [allow_entry]/[load_allow_list]. *) +(* test_oracle.ml's own [allow_entry]/[load_allow_list]. ONE allow-list *) +(* file for all three editions (they are one lineage, the same publisher *) +(* and compiler) -- an entry's own [note] names which edition(s) it fired *) +(* on when that matters. *) (* ---------------------------------------------------------------------- *) type allow_entry = { id : string; citation : string; verdict : string; note : string; expected_rows : int } [@@deriving sexp] -let load_allow_list () = +let load_allow_list allow_list_path = 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) @@ -260,213 +234,19 @@ let load_allow_list () = List.map allow_entry_of_sexp sexps (* ---------------------------------------------------------------------- *) -(* Tests *) -(* ---------------------------------------------------------------------- *) - -let test_fixture_checksum () = - Alcotest.(check string) "fixture SHA-256 matches its provenance note" fixture_sha256 - (sha256_of_file fixture_path) - -let test_dates_align () = - let ordo = ordo_rows () in - let colitur = colitur_rows () in - Alcotest.(check int) "the Ordo fixture has 400 rows (2024-11-27..2025-12-31)" 400 (List.length ordo); - Alcotest.(check int) "colitur resolved the same number of days" (List.length ordo) (List.length colitur); - (match ordo with o :: _ -> Alcotest.(check string) "first date" window_first o.date | [] -> Alcotest.fail "empty"); - (match List.rev ordo with - | o :: _ -> Alcotest.(check string) "last date" window_last o.date - | [] -> Alcotest.fail "empty"); - let mismatched = - List.filter_map - (fun (o, c) -> if String.equal o.date c.c_date then None else Some (o.date, c.c_date)) - (List.combine ordo colitur) - in - Alcotest.(check (list (pair string string))) "no misaligned dates" [] mismatched - -(* Good Friday (2025-04-18) has no Mass at all in the 1955-restored Holy - Week -- the Ordo prints no Gl/Cr line, confirmed directly against the - source (extract_lms_ordo's own row for that date, and the raw pdftotext - text: "The Solemn Liturgical Action is celebrated in the afternoon...", - no "Gl"/"Cr" token anywhere in the block). Asserted as the ONLY such - day, not merely observed once: a future parsing regression that - swallowed a real Gl/Cr line would otherwise silently join this - "not applicable" bucket instead of failing loudly as an unexplained - mismatch. *) -let test_creed_coverage () = - let ordo = ordo_rows () in - let no_creed = List.filter (fun o -> o.creed = None) ordo in - Alcotest.(check (list string)) "only Good Friday has no Ordo Creed marker" [ "2025-04-18" ] - (List.map (fun o -> o.date) no_creed) - -let describe_creed_mismatch (o : ordo_row) (c : colitur_row) = - Printf.sprintf "%s %S: colitur creed=%b, Ordo creed=%b (formulary=%s)" o.date o.title c.c_creed - (Option.get o.creed) - (match c.c_formulary with - | Some { MF.said = Some s; _ } -> Colitur_kernel.Slug.to_string s - | Some { MF.said = None; via = MF.Votive } -> "votive (said unnamed in the data)" - | Some { MF.said = None; _ } -> "NONE (said, unexpectedly outside Votive)" - | None -> "NONE") - -(* The core assertion: every Creed divergence, over all 400 days (Good - Friday excluded per [test_creed_coverage] above -- it is not a - divergence, it is a day with nothing on the Ordo's side to compare), - falls in a named, cited, adjudicated allow-list entry. Zero - unexplained. *) -let test_creed_matches_or_is_explained () = - let ordo = ordo_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 - (* No known Creed divergence is adjudicated any more: L1 (RG 476(f), All - Souls' Day) was CLOSED by fixing {!Rite_ef.Rubrics_ef.creed} itself - (whole-branch review finding 1), not by re-adjudicating it -- see - expected-divergences-lms.sexp's own closure note for the citation and - the measured blast radius. [allow_list] is therefore expected to be - empty today; the [by_id]/[explained_counts] wiring below is kept - rather than deleted, because the "every declared entry must have - fired" check at the end is a real invariant worth keeping live even - while the list itself is empty -- exactly the shape a FUTURE entry of - this kind would need. *) - let unexplained = ref [] in - let explained_counts = Hashtbl.create 8 in - List.iter2 - (fun (o : ordo_row) (c : colitur_row) -> - if not (String.equal o.date c.c_date) then Alcotest.failf "misaligned: ordo %s vs colitur %s" o.date c.c_date; - match o.creed with - | None -> () (* Good Friday, see test_creed_coverage *) - | Some ocreed -> - if Bool.equal ocreed c.c_creed then () else unexplained := describe_creed_mismatch o c :: !unexplained) - ordo colitur; - Alcotest.(check (list string)) "every Creed mismatch is named in the allow-list -- none unexplained" [] - (List.rev !unexplained); - Hashtbl.iter - (fun id n -> - match List.assoc_opt id by_id with - | None -> Alcotest.failf "allow-list entry %s used by the comparator but not declared in %s" id allow_list_path - | Some e -> - Alcotest.(check int) (Printf.sprintf "%s: expected_rows matches the actual count" id) e.expected_rows n) - explained_counts; - (* every declared entry must actually have fired, so the allow-list - cannot silently accumulate a dead entry nothing triggers any more *) - List.iter - (fun e -> - if not (Hashtbl.mem explained_counts e.id) then - Alcotest.failf "allow-list entry %s is declared but never matched a real divergence" e.id) - allow_list - -(* ---------------------------------------------------------------------- *) -(* The BVM-Saturday seasonal selection -- the coordinator addendum's own *) -(* "sharper check". Restricted to colitur's [Votive] days, which is *) -(* exactly {!Rite_ef.Lectionary_ef.is_bvm_saturday_office}'s own domain. *) -(* ---------------------------------------------------------------------- *) - -let test_bvm_seasonal_selection () = - let ordo = ordo_rows () in - let colitur = colitur_rows () in - let votive_pairs = - List.filter_map - (fun (o, c) -> - match c.c_formulary with - | Some { MF.via = MF.Votive; _ } -> Some (o, c) - | _ -> None) - (List.combine ordo colitur) - in - Alcotest.(check int) "14 BVM-Saturday (Votive) days fall inside the fixture's own window" 14 - (List.length votive_pairs); - let mismatches = - List.filter_map - (fun (o, c) -> - let expected = expected_bvm_numeral c.c_season ~month:(int_of_string (String.sub c.c_date 5 2)) - ~day:(int_of_string (String.sub c.c_date 8 2)) in - match o.bvm_numeral with - | Some got when String.equal got expected -> None - | Some got -> Some (Printf.sprintf "%s: Ordo says %s, expected %s (season-derived)" o.date got expected) - | None -> Some (Printf.sprintf "%s: colitur says Votive but the Ordo shows no BVM numeral" o.date)) - votive_pairs - in - Alcotest.(check (list string)) "every BVM-Saturday numeral matches its season -- none unexplained" [] mismatches - -(* Reverse direction: every Ordo BVM-numeral day is a colitur Votive day - too (rules out the Ordo naming a Saturday BVM Mass colitur never - computed the office for at all). *) -let test_bvm_numeral_implies_votive () = - let ordo = ordo_rows () in - let colitur = colitur_rows () in - let mismatches = - List.filter_map - (fun (o, c) -> - match (o.bvm_numeral, c.c_formulary) with - | Some n, Some { MF.via = MF.Votive; _ } -> ignore n; None - | Some n, other -> - Some - (Printf.sprintf "%s: Ordo shows %S Mass of BVM but colitur's via is %s" o.date n - (match other with - | Some f -> MF.source_to_string f.MF.via - | None -> "NONE")) - | None, _ -> None) - (List.combine ordo colitur) - in - Alcotest.(check (list string)) "every Ordo BVM numeral day is a colitur Votive day" [] mismatches - -(* ---------------------------------------------------------------------- *) -(* Formulary override, restricted to Proper/Preceding_sunday/Common -- *) +(* Formulary override, restricted to Proper/Common/Preceding_sunday -- *) (* see this file's own header for why Own_slug is excluded, and Votive is *) -(* covered by the BVM checks above instead. *) -(* *) -(* Whole-branch review finding 2: the ORIGINAL version of this test only *) -(* checked WHETHER a Preceding_sunday day showed an override line, never *) -(* WHICH Sunday it named -- so colitur could resume the WRONG Sunday on *) -(* every one of the 66 such days and this layer would stay green (step 3 *) -(* of the reading chain, {!Rite_ef.Lectionary_ef.readings}, is exactly the *) -(* code this was supposed to be testing). Fixed by deriving the EXPECTED *) -(* prose from {!MF.t.said}'s own resolved SLUG -- not by calling colitur's *) -(* own [sunday_slug] a second time (which would make the check tautological, *) -(* the same reasoning this file's own header already gives for *) -(* re-deriving the BVM numeral rather than calling {!Rite_ef. *) -(* Lectionary_ef.bvm_saturday_citations}). The FIRST version of this fix *) -(* instead recomputed the preceding Sunday's DATE and re-derived (season, *) -(* week) via {!Rite_ef.Temporal_ef.temporal} independently -- and was WRONG, caught by its *) -(* own assertion on the very first run: {!Rite_ef.Temporal_ef.temporal}'s raw [week] field *) -(* and the SLUG's own embedded number genuinely diverge for the last *) -(* Sunday before Advent (always slug-numbered "24", whatever the raw week *) -(* count that year -- temporal_ef.ml's own [sunday_slug], the *) -(* [same d last_sunday] branch) and for the "surplus Sundays" that resume *) -(* Epiphany's own numbering when Septuagesima cut it short (same function, *) -(* the [n > 23] branch) -- exactly the two hard cases that function's own *) -(* comment names. Parsing the number back OUT of the already-resolved slug *) -(* sidesteps both: it is not tautological with the wrong-Sunday failure *) -(* mode this whole fix exists to catch (a wrong slug still parses to a *) -(* wrong number, which still fails to match the Ordo's real text), and it *) -(* is simpler and more robust than re-deriving the two special cases a *) -(* second time by hand. *) +(* covered by the BVM checks instead. Unchanged from Task 6 except for *) +(* being read per-window rather than off a single hardcoded fixture. *) (* ---------------------------------------------------------------------- *) -(* English ordinal suffix: 1st, 2nd, 3rd, 4th, 11th, 12th, 13th, 21st... -- - the "teens" exception applies to every multiple of 100 plus 11-13, not - just 11-13 themselves, but nothing in this fixture's own domain (weeks - 1-24) ever reaches three digits, so the simpler [n mod 100] test below - is exercised fully by 11-13 alone and is not a latent bug for values - this function is actually ever called with. *) let ordinal n = let suffix = if n mod 100 >= 11 && n mod 100 <= 13 then "th" - else - match n mod 10 with - | 1 -> "st" - | 2 -> "nd" - | 3 -> "rd" - | _ -> "th" + else match n mod 10 with 1 -> "st" | 2 -> "nd" | 3 -> "rd" | _ -> "th" in Printf.sprintf "%d%s" n suffix -(* [MF.t.said]'s own slug shape for every Preceding_sunday day observed in - the real fixture is [ef-<season-word>-sunday-<n>] ({!Rite_ef.Temporal_ef.sunday_slug}'s - own generic branch -- the ONLY branch that ever reaches a weekday's - [Preceding_sunday] fallback; the specially-NAMED Sundays [ef-low-sunday], - [ef-palm-sunday] etc. are caught by {!Rite_ef.Temporal_ef.named} first and never fall - through to it). Manual parsing, not [Str]/regex (deps frozen): finds the - last "-sunday-" marker and splits on it, since a season word can itself - contain hyphens ("time-after-pentecost") but never contains "-sunday-". *) let parse_sunday_slug slug = let prefix = "ef-" in let plen = String.length prefix in @@ -485,14 +265,23 @@ let parse_sunday_slug slug = let num_str = String.sub body (i + mlen) (blen - i - mlen) in match int_of_string_opt num_str with Some n -> Some (word, n) | None -> None) -(* The Ordo's own prose, derived from [MF.t.said]'s own (season-word, - number) -- verified against every one of the 66 real Preceding_sunday - days in the fixture (test_formulary_override_matches below), not - invented from the naming convention alone. [None] means "this pair is - EXCLUDED from the mapping", handled explicitly by the caller, never - silently -- see [ascension_week_override] just below for the one real - population that lands there. *) -let expected_preceding_sunday_override (word : string) (n : int) = +(* [~season] disambiguates ONE genuinely ambiguous case, found extending + this suite to the 2023-2024 window (2024-11-05..08): colitur's own + "resumed-Sunday tail" (CLAUDE.md's own term) REUSES an Epiphany Sunday's + own slug ([ef-time-after-epiphany-sunday-4]) for a feria whose REAL + calendar date falls in November, inside Time after Pentecost -- Easter + was late enough in 2024 that not every Epiphany Sunday got "used" before + Septuagesima cut the season short, so the leftover ones resume near the + END of the year instead. The Ordo's own prose distinguishes the two + occurrences of the SAME slug by wording alone: "4th Sunday after the + Epiphany" in January, "4th Sunday REMAINING after the Epiphany" in + November (verified directly against the raw dump). [c_season] is the + feria's own actual calendar season -- [Time_after_epiphany] for the + January occurrence, [Time_after_pentecost] for the November one -- so + comparing it against the WORD parsed out of the resumed slug ("time- + after-epiphany" either way) is exactly the signal needed, with no new + colitur-side field required. *) +let expected_preceding_sunday_override ~(season : V.season) (word : string) (n : int) = match (word, n) with | "advent", 1 -> Some "Advent Sunday" | "advent", 2 -> Some "2nd Sunday of Advent" @@ -501,113 +290,118 @@ let expected_preceding_sunday_override (word : string) (n : int) = | "septuagesima", 1 -> Some "Septuagesima Sunday" | "septuagesima", 2 -> Some "Sexagesima Sunday" | "septuagesima", 3 -> Some "Quinquagesima Sunday" - | "time-after-epiphany", n -> Some (Printf.sprintf "%s Sunday after the Epiphany" (ordinal n)) + | "time-after-epiphany", n when season = V.Time_after_epiphany -> + Some (Printf.sprintf "%s Sunday after the Epiphany" (ordinal n)) + | "time-after-epiphany", n -> Some (Printf.sprintf "%s Sunday remaining after the Epiphany" (ordinal n)) | "time-after-pentecost", 24 -> Some "24th & Last Sunday After Pentecost" | "time-after-pentecost", n -> Some (Printf.sprintf "%s Sunday after Pentecost" (ordinal n)) - (* [ef-easter-sunday-<n>]: Paschaltide's own numbering counts Easter - Sunday itself as 1 (Low Sunday, named separately via {!Rite_ef.Temporal_ef.named} and - so never reaching this generic branch at all, is 2), so the ordinal - PRINTED is [n - 1] -- confirmed against every one of n=3..5 in the - fixture ("2nd" through "4th" Sunday after Easter). n=6,7 are - deliberately NOT given here: see [ascension_week_override]. *) - | "easter", n when n >= 3 && n <= 5 -> Some (Printf.sprintf "%s Sunday after Easter" (ordinal (n - 1))) + (* [n >= 3], no upper bound: Task 6's original [n <= 5] excluded n=6/7 on + the (overfit, 2024-2025-window-only) assumption that EVERY such day is + Ascension-adjacent. Extending to 2023-2024/2025-2026 found a REAL + counter-example -- Rogation Monday (RG 87-89), which also resumes + week 6's own Sunday but falls BEFORE Ascension, not after, and the + Ordo prints the ordinary "5th Sunday after Easter" there, not "Mass + of the Ascension". The caller now decides Ascension-adjacency by the + day's own DATE against {!Computus.ascension}, not by [n] -- so this + mapping can be trusted for n=6/7 whenever the caller does not first + divert to [ascension_week_override]. *) + | "easter", n when n >= 3 -> Some (Printf.sprintf "%s Sunday after Easter" (ordinal (n - 1))) | _ -> None -(* One NAMED Sunday (not a generic "ef-<season>-sunday-<n>" slug at all) - reaches [Preceding_sunday] in the real 66-day population: Christ the - King ({!Rite_ef.Temporal_ef.christ_the_king}, "the last Sunday of - October"), whose own ferias resume it the same way any other Sunday's - would. Unlike the Septuagesima trio's fixed proper names, its ORDINAL - position among the Sundays after Pentecost is not fixed -- it varies - year to year with Easter's own date -- so there is no string this - function could hard-code the way [expected_preceding_sunday_override] - does for the others. [word]/[n] cannot express it EITHER, because - {!Rite_ef.Temporal_ef.named} overrides the SLUG for that Sunday but, - confirmed directly in temporal_ef.ml ([build ~season ~slug ~colour - ~rank ~week:(week d) ()], called identically whether or not [named] - matched), never the raw [week] FIELD -- so re-deriving that one field - for this one named exception is not the same mistake the first version - of this fix made re-deriving [week] WHOLESALE (that failed on the - season's own two special-numbering cases, both of which this function - sidesteps by reading the slug directly); here there is no slug number - to read in the first place, so [week] is the only source of truth, - narrowly applied to the single slug that needs it. *) let expected_named_sunday_override slug ~year = if String.equal slug "ef-christ-the-king" then match TE.week (TE.christ_the_king year) with | Some n -> Some (Printf.sprintf "%s Sunday after Pentecost" (ordinal n)) | None -> None + (* [ef-low-sunday]: a SECOND named-Sunday population reaching + [Preceding_sunday], found the same way [ef-christ-the-king] was -- + absent from the 2024-2025 window Task 6 built this mapping against + (every Low-Sunday-week feria that year had its own proper), present + in both 2023-2024 (9-12 April 2024) and 2025-2026. The Ordo's own + text is the plain, unnumbered "Mass of Low Sunday". *) + else if String.equal slug "ef-low-sunday" then Some "Low Sunday" else None -(* [n] = 6 or 7 (Paschaltide's own numbering, see the comment above -- the - calendar Sundays traditionally called the 5th and 6th Sunday after - Easter) are STRUCTURALLY, not coincidentally, always Ascension-adjacent: - the Ascension is a fixed Easter+39 (a Thursday inside week 6), so EVERY - feria whose own [Preceding_sunday] fallback would otherwise resolve to - one of these two weeks falls between Ascension Thursday and the - following Saturday, every year, not merely in this fixture's own - 2024-2025 window. A REAL finding, not a fixture artefact: the Ordo - shows "Mass of the Ascension" on all three such days this window - contains (2025-05-30, 2025-06-02, 2025-06-03 -- Friday and the - following Monday/Tuesday, the days between Ascension and the Sunday - after it that have no proper of their own), never "5th"/"6th Sunday - after Easter" -- the Missal keeps saying ASCENSION's own Mass through - this stretch, not the last numbered Sunday's. colitur's step 3 has no - notion of "inside Ascension's own after-feast period" -- it always - resumes the nearest PRECEDING SUNDAY, numbered or not -- so on these - three real days {!MF.t.said} is a plain "ef-easter-sunday-6"/"-7" slug - the Missal would never actually print as such. A genuine content gap in - colitur's reading chain, found by this fix, NOT fixed here (fixing it - means teaching step 3 or the lectionary data about Ascension's own - after-feast period, a lectionary-data change out of this fix round's - own scope) -- recorded honestly, the same way L1 in - expected-divergences-lms.sexp already records the 476(f) gap this same - branch closed, and counted below so a change to this population would - be caught rather than silently absorbed. *) +(* See Task 6's own [ascension_week_override] citation (test_lms_ordo.ml + history, expected-divergences-lms.sexp L2): STRUCTURAL, not a fixture + artefact -- the Ascension is a fixed Easter+39, so every feria whose own + [Preceding_sunday] fallback would otherwise resolve to a week-6/7 Sunday + falls, in SOME years, between Ascension Thursday and the following + Sunday. Extending this suite past the single 2024-2025 window sharpened + the finding: it is specifically the days AFTER Ascension (not merely + "any week-6/7 Preceding_sunday day") that get this treatment -- see + [expected_preceding_sunday_override]'s own citation for the Rogation + Monday counter-example that exposed the difference. [is_ascension_week] + below is the corrected predicate: the day's own DATE compared against + {!Computus.ascension} for its own year, not [n]. *) let ascension_week_override = "Mass of the Ascension" -let test_formulary_override_matches () = - let ordo = ordo_rows () in - let colitur = colitur_rows () in +(* Bounded ABOVE by Pentecost, not merely "later than Ascension" -- a bare + lower bound is wrong for any date past Ascension in the SAME civil year + (every date from June to December satisfies "> Ascension", which a + first version of this predicate did and it manufactured 8 false + failures across the 2024-2025/2025-2026 windows, in July/November/ + December, caught immediately by re-running against those two + previously-clean windows). Task 6's own original population (Friday + after Ascension, then the following Monday/Tuesday) already showed the + window extends PAST the immediately-following Sunday, not merely up to + it, so Pentecost -- the next fixed liturgical anchor, Easter+49 -- is + the natural, provable upper bound: nothing in this stretch has its own + proper once Ascension's octave-like privilege takes over, and Pentecost + itself always does (RG 91 entry 3). *) +let is_after_ascension date = + let year = Date.year date in + Date.compare date (Computus.ascension year) > 0 && Date.compare date (Computus.pentecost year) < 0 + +type formulary_counts = { + fc_bad : string list; + fc_proper : int; + fc_common : int; + fc_preceding_sunday : int; + fc_ascension_week : int; +} + +let check_formulary_overrides ordo colitur = let pairs = List.combine ordo colitur in - let counts = Hashtbl.create 8 in - let bump k = Hashtbl.replace counts k (1 + try Hashtbl.find counts k with Not_found -> 0) in + let proper = ref 0 and common = ref 0 and preceding_sunday = ref 0 and ascension_week = ref 0 in let bad = ref [] in - let ascension_week_count = ref 0 in List.iter - (fun (o, c) -> + (fun ((o : ordo_row), (c : colitur_row)) -> match c.c_formulary with | Some { MF.via = MF.Proper; _ } -> - bump "proper"; + incr proper; if o.formulary_override <> None then bad := Printf.sprintf "%s: Proper day but Ordo shows override %s" o.date (Option.get o.formulary_override) :: !bad | Some { MF.via = MF.Common; _ } -> - bump "common"; + incr common; if o.formulary_override <> None then bad := Printf.sprintf "%s: Common day but Ordo shows override %s" o.date (Option.get o.formulary_override) :: !bad | Some { MF.via = MF.Preceding_sunday; said } -> ( - bump "preceding_sunday"; - (* [said] is [Some] for every constructor except [Votive] (see - {!Colitur_kernel.Mass_formulary.t}'s own citation) -- a bare - [Option.get] here would raise an unhelpful exception if that - ever stopped being true; [Alcotest.failf] names the day - instead. *) + incr preceding_sunday; let slug = match said with | Some s -> Colitur_kernel.Slug.to_string s | None -> Alcotest.failf "%s: Preceding_sunday day with said = None (should be impossible)" o.date in let ordo_says = Printf.sprintf "Mass of %s" in - (* Try the generic [ef-<season>-sunday-<n>] shape first; fall back - to the one NAMED Sunday that also reaches this population - ([expected_named_sunday_override], see its own citation) when - the slug doesn't parse that way at all. *) let year = int_of_string (String.sub o.date 0 4) in + let date = match Date.of_iso8601 o.date with Ok d -> d | Error e -> Alcotest.failf "%s: %s" o.date e in + if is_after_ascension date then ( + match o.formulary_override with + | Some got when String.equal got ascension_week_override -> incr ascension_week + | Some got -> + bad := + Printf.sprintf "%s: colitur resumed %S (after Ascension), Ordo shows %S, not the adjudicated %S" + o.date slug got ascension_week_override + :: !bad + | None -> + bad := Printf.sprintf "%s: colitur resumed %S (after Ascension), Ordo shows no override" o.date slug :: !bad) + else let expected = match parse_sunday_slug slug with - | Some (word, n) -> expected_preceding_sunday_override word n + | Some (word, n) -> expected_preceding_sunday_override ~season:c.c_season word n | None -> expected_named_sunday_override slug ~year in match expected with @@ -618,13 +412,8 @@ let test_formulary_override_matches () = | Some got -> bad := Printf.sprintf "%s: colitur resumed %S, Ordo says %S" o.date expected_line got :: !bad | None -> bad := Printf.sprintf "%s: colitur resumed %S, Ordo shows no override" o.date expected_line :: !bad) | None -> ( - (* The Ascension-week exclusion above -- checked, not - assumed: fails loudly if the Ordo's own text ever stops - matching the one string this population is adjudicated to - carry, or if a slug outside every adjudicated case above - ever reaches here. *) match o.formulary_override with - | Some got when String.equal got ascension_week_override -> incr ascension_week_count + | Some got when String.equal got ascension_week_override -> incr ascension_week | Some got -> bad := Printf.sprintf "%s: unmapped (colitur resumed %S) and Ordo shows %S, not the adjudicated %S" o.date @@ -634,33 +423,214 @@ let test_formulary_override_matches () = bad := Printf.sprintf "%s: unmapped (colitur resumed %S) and Ordo shows no override" o.date slug :: !bad)) | Some { MF.via = MF.Votive; _ } | Some { MF.via = MF.Own_slug; _ } | None -> ()) pairs; - Alcotest.(check (list string)) "every formulary-override mismatch is explained -- none unexplained" [] (List.rev !bad); - Alcotest.(check int) "179 Proper days in the window" 179 (try Hashtbl.find counts "proper" with Not_found -> 0); - Alcotest.(check int) "2 Common days in the window" 2 (try Hashtbl.find counts "common" with Not_found -> 0); - Alcotest.(check int) "66 Preceding_sunday days in the window" 66 - (try Hashtbl.find counts "preceding_sunday" with Not_found -> 0); - Alcotest.(check int) "3 Preceding_sunday days fall in the Ascension-week exclusion, no more, no fewer" 3 - !ascension_week_count + { fc_bad = List.rev !bad; fc_proper = !proper; fc_common = !common; fc_preceding_sunday = !preceding_sunday; + fc_ascension_week = !ascension_week } -let test_via_distribution_totals_400 () = - let colitur = colitur_rows () in - let via_name c = - match c.c_formulary with - | None -> "none" - | Some f -> MF.source_to_string f.MF.via - in - let counts = Hashtbl.create 8 in - List.iter - (fun c -> Hashtbl.replace counts (via_name c) (1 + try Hashtbl.find counts (via_name c) with Not_found -> 0)) - colitur; - let total = Hashtbl.fold (fun _ n acc -> acc + n) counts 0 in - Alcotest.(check int) "every via bucket sums to the full 400-day window" 400 total +(* ---------------------------------------------------------------------- *) +(* [make_suite]: one edition's worth of tests, parameterised. Every count *) +(* below is a genuine per-edition PIN (measured once against real data, *) +(* not guessed), the same discipline every other golden/oracle fixture in *) +(* this suite already uses -- a change to any of them is a real finding, *) +(* not noise to silence. *) +(* ---------------------------------------------------------------------- *) -let suite = - ( "lms-ordo", +let make_suite ~label ~fixture_path ~fixture_sha256 ~window_first ~window_last ~year_lo ~year_hi ~allow_list_path + ~expected_rows ~expected_bvm_votive ~expected_proper ~expected_common ~expected_preceding_sunday + ~expected_ascension_week = + let test_fixture_checksum () = + Alcotest.(check string) "fixture SHA-256 matches its provenance note" fixture_sha256 + (sha256_of_file fixture_path) + in + let test_dates_align () = + let ordo = ordo_rows fixture_path in + let colitur = colitur_rows ~year_lo ~year_hi ~window_first ~window_last in + Alcotest.(check int) (Printf.sprintf "the Ordo fixture has %d rows (%s..%s)" expected_rows window_first window_last) + expected_rows (List.length ordo); + Alcotest.(check int) "colitur resolved the same number of days" (List.length ordo) (List.length colitur); + (match ordo with o :: _ -> Alcotest.(check string) "first date" window_first o.date | [] -> Alcotest.fail "empty"); + (match List.rev ordo with + | o :: _ -> Alcotest.(check string) "last date" window_last o.date + | [] -> Alcotest.fail "empty"); + let mismatched = + List.filter_map + (fun (o, c) -> if String.equal o.date c.c_date then None else Some (o.date, c.c_date)) + (List.combine ordo colitur) + in + Alcotest.(check (list (pair string string))) "no misaligned dates" [] mismatched + in + (* This window's own Good Friday(s) (Easter-2, RE-DERIVED here from + {!Computus.gregorian_easter} for every civil year the window touches, + never hardcoded) is the only day expected to carry no Ordo Creed + marker at all -- Good Friday has no Mass in the 1955-restored Holy + Week. Exactly one such date falls inside any one edition's ~13-month + window (its OTHER Easter, a year apart, falls outside it), but this + is computed, not assumed: a window that unexpectedly contained zero or + two would be a real finding this test would catch. *) + let window_good_fridays () = + let first_year = int_of_string (String.sub window_first 0 4) in + let last_year = int_of_string (String.sub window_last 0 4) in + let candidates = + List.concat_map + (fun y -> + let gf = Date.add_days (Computus.gregorian_easter y) (-2) in + [ Date.to_iso8601 gf ]) + (List.init (last_year - first_year + 1) (fun i -> first_year + i)) + in + List.filter (fun d -> String.compare d window_first >= 0 && String.compare d window_last <= 0) candidates + in + let test_creed_coverage () = + let ordo = ordo_rows fixture_path in + let no_creed = List.filter (fun o -> o.creed = None) ordo in + let expected = window_good_fridays () in + Alcotest.(check (list string)) "only this window's own Good Friday has no Ordo Creed marker" expected + (List.map (fun o -> o.date) no_creed) + in + let describe_creed_mismatch (o : ordo_row) (c : colitur_row) = + Printf.sprintf "%s %S: colitur creed=%b, Ordo creed=%b (formulary=%s)" o.date o.title c.c_creed + (Option.get o.creed) + (match c.c_formulary with + | Some { MF.said = Some s; _ } -> Colitur_kernel.Slug.to_string s + | Some { MF.said = None; via = MF.Votive } -> "votive (said unnamed in the data)" + | Some { MF.said = None; _ } -> "NONE (said, unexpectedly outside Votive)" + | None -> "NONE") + in + (* Which allow-list id, if any, explains a Creed mismatch on this date. + Date-keyed (not merely "any mismatch is fine") deliberately: an id + that stops firing, or fires on a NEW date it was never adjudicated + for, must be visible as a real change, not silently absorbed by a + loose "some entry explains something" check. Task 6's own version of + this function declared [by_id]/[explained_counts] but never actually + populated the latter (the mechanism this comment sits in) -- L1 was + already CLOSED by the time that task shipped, so it had nothing real + to explain and the gap went unexercised. L3/L4 (Witnesses task, + 2026-08-22, both 2023-2024-only) are the first live tests of it. *) + let allow_list_id_for_date d = + if String.equal d "2024-02-24" then Some "L3" + else if String.equal d "2023-12-24" then Some "L4" + else None + in + let test_creed_matches_or_is_explained () = + let ordo = ordo_rows fixture_path in + let colitur = colitur_rows ~year_lo ~year_hi ~window_first ~window_last in + let allow_list = load_allow_list allow_list_path in + let by_id = List.map (fun e -> (e.id, e)) allow_list in + let unexplained = ref [] in + let explained_counts = Hashtbl.create 8 in + List.iter2 + (fun (o : ordo_row) (c : colitur_row) -> + if not (String.equal o.date c.c_date) then Alcotest.failf "misaligned: ordo %s vs colitur %s" o.date c.c_date; + match o.creed with + | None -> () + | Some ocreed -> + if Bool.equal ocreed c.c_creed then () + else ( + match allow_list_id_for_date o.date with + | Some id -> Hashtbl.replace explained_counts id (1 + try Hashtbl.find explained_counts id with Not_found -> 0) + | None -> unexplained := describe_creed_mismatch o c :: !unexplained)) + ordo colitur; + Alcotest.(check (list string)) (Printf.sprintf "[%s] every Creed mismatch is named in the allow-list -- none unexplained" label) + [] (List.rev !unexplained); + Hashtbl.iter + (fun id n -> + match List.assoc_opt id by_id with + | None -> Alcotest.failf "allow-list entry %s used by the comparator but not declared in %s" id allow_list_path + | Some e -> + Alcotest.(check int) (Printf.sprintf "%s: expected_rows matches the actual count" id) e.expected_rows n) + explained_counts + in + let test_bvm_seasonal_selection () = + let ordo = ordo_rows fixture_path in + let colitur = colitur_rows ~year_lo ~year_hi ~window_first ~window_last in + let votive_pairs = + List.filter_map + (fun (o, c) -> match c.c_formulary with Some { MF.via = MF.Votive; _ } -> Some (o, c) | _ -> None) + (List.combine ordo colitur) + in + Alcotest.(check int) (Printf.sprintf "%d BVM-Saturday (Votive) days fall inside this window" expected_bvm_votive) + expected_bvm_votive (List.length votive_pairs); + let mismatches = + List.filter_map + (fun (o, c) -> + let expected = expected_bvm_numeral c.c_season ~month:(int_of_string (String.sub c.c_date 5 2)) + ~day:(int_of_string (String.sub c.c_date 8 2)) in + match o.bvm_numeral with + | Some got when String.equal got expected -> None + | Some got -> Some (Printf.sprintf "%s: Ordo says %s, expected %s (season-derived)" o.date got expected) + | None -> + (* One SOURCE-TEXT anomaly, found extending this suite to + 2023-2024: 2024-02-03 is the ONLY BVM-Saturday day in the + 2023-2024 fixture (of 12) whose Ordo entry carries no + roman-numeral "<N> Mass of BVM" line at all. Verified + directly against the raw pdftotext dump (not inferred): + every OTHER BVM-Saturday day in this edition prints "Sat + <n> CELEBRATION of the BVM IV Cl W" immediately followed + by its own "<N> Mass of BVM" line; this one date's block + goes straight from the title line to "(Blessing of + throats in honour of St Blaise may be given on this + day)" -- the numeral line the Ordo's own layout convention + would otherwise print is simply MISSING from the printed + text, a publisher-side omission this session cannot + correct, not a colitur defect (colitur's own side is + independently right here: St Blaise is scan-verified + "Com." -- a bare commemoration, not a feast -- in the + calendarium itself, docs/research/LT.txt:4978, so RG 91's + table has no row for him and the BVM-Saturday office + correctly wins the day outright, exactly as colitur + computes). Excluded by name, not silently: a future + change to this population (a different date, or a SECOND + gap) would still be caught below. *) + if String.equal fixture_path "fixtures/lms-ordo-2023-2024.sexp" && String.equal o.date "2024-02-03" then + None + else Some (Printf.sprintf "%s: colitur says Votive but the Ordo shows no BVM numeral" o.date)) + votive_pairs + in + Alcotest.(check (list string)) "every BVM-Saturday numeral matches its season -- none unexplained" [] mismatches + in + let test_bvm_numeral_implies_votive () = + let ordo = ordo_rows fixture_path in + let colitur = colitur_rows ~year_lo ~year_hi ~window_first ~window_last in + let mismatches = + List.filter_map + (fun (o, c) -> + match (o.bvm_numeral, c.c_formulary) with + | Some n, Some { MF.via = MF.Votive; _ } -> ignore n; None + | Some n, other -> + Some + (Printf.sprintf "%s: Ordo shows %S Mass of BVM but colitur's via is %s" o.date n + (match other with Some f -> MF.source_to_string f.MF.via | None -> "NONE")) + | None, _ -> None) + (List.combine ordo colitur) + in + Alcotest.(check (list string)) "every Ordo BVM numeral day is a colitur Votive day" [] mismatches + in + let test_formulary_override_matches () = + let ordo = ordo_rows fixture_path in + let colitur = colitur_rows ~year_lo ~year_hi ~window_first ~window_last in + let r = check_formulary_overrides ordo colitur in + Alcotest.(check (list string)) "every formulary-override mismatch is explained -- none unexplained" [] r.fc_bad; + Alcotest.(check int) (Printf.sprintf "%d Proper days in the window" expected_proper) expected_proper r.fc_proper; + Alcotest.(check int) (Printf.sprintf "%d Common days in the window" expected_common) expected_common r.fc_common; + Alcotest.(check int) (Printf.sprintf "%d Preceding_sunday days in the window" expected_preceding_sunday) + expected_preceding_sunday r.fc_preceding_sunday; + Alcotest.(check int) + (Printf.sprintf "%d Preceding_sunday days fall in the Ascension-week exclusion, no more, no fewer" + expected_ascension_week) + expected_ascension_week r.fc_ascension_week + in + let test_via_distribution_totals () = + let colitur = colitur_rows ~year_lo ~year_hi ~window_first ~window_last in + let via_name c = match c.c_formulary with None -> "none" | Some f -> MF.source_to_string f.MF.via in + let counts = Hashtbl.create 8 in + List.iter + (fun c -> Hashtbl.replace counts (via_name c) (1 + try Hashtbl.find counts (via_name c) with Not_found -> 0)) + colitur; + let total = Hashtbl.fold (fun _ n acc -> acc + n) counts 0 in + Alcotest.(check int) "every via bucket sums to the full window" expected_rows total + in + ( label, [ Alcotest.test_case "fixture SHA-256 matches its provenance note" `Quick test_fixture_checksum; - Alcotest.test_case "streams are 400 rows each, dates aligned 1:1" `Quick test_dates_align; - Alcotest.test_case "only Good Friday has no Ordo Creed marker" `Quick test_creed_coverage; + Alcotest.test_case "streams are N rows each, dates aligned 1:1" `Quick test_dates_align; + Alcotest.test_case "only this window's own Good Friday has no Ordo Creed marker" `Quick test_creed_coverage; Alcotest.test_case "every Creed difference is named in the cited allow-list -- none unexplained" `Quick test_creed_matches_or_is_explained; Alcotest.test_case "every BVM-Saturday numeral matches its season" `Quick test_bvm_seasonal_selection; @@ -668,5 +638,42 @@ let suite = test_bvm_numeral_implies_votive; Alcotest.test_case "formulary override STRING matches on Proper/Common/Preceding_sunday days" `Quick test_formulary_override_matches; - Alcotest.test_case "the via distribution sums to the full window" `Quick test_via_distribution_totals_400 + Alcotest.test_case "the via distribution sums to the full window" `Quick test_via_distribution_totals ] ) + +let allow_list_path = "../data/ef/expected-divergences-lms.sexp" + +(* Guards against a stale allow-list entry (declared in the sexp file, but + the OCaml-side [allow_list_id_for_date] predicate above no longer maps + any date to it, or never did) -- the per-window suites above only prove + an id that DOES fire has the right count; nothing in them can notice an + id that never fires in ANY of the three windows, since each suite only + ever looks at its own explained_counts. Fixed to the two ids this task + added (L3, L4) -- L1 is CLOSED/removed and L2 is deliberately prose-only + (see the sexp file's own header on why), so neither is expected here. *) +let test_allow_list_ids_are_exactly_l3_l4 () = + let ids = List.sort String.compare (List.map (fun e -> e.id) (load_allow_list allow_list_path)) in + Alcotest.(check (list string)) "the LMS allow-list declares exactly L3 and L4" [ "L3"; "L4" ] ids + +let suite_allow_list = ("lms-ordo-allow-list", [ Alcotest.test_case "declares exactly L3 and L4" `Quick test_allow_list_ids_are_exactly_l3_l4 ]) + +let suite_2023_2024 = + make_suite ~label:"lms-ordo-2023-2024" ~fixture_path:"fixtures/lms-ordo-2023-2024.sexp" + ~fixture_sha256:"c8d9d4b790f6b4438e932f70dad8ebe9a0316662f1eb02c26248e04c7be1a62b" ~window_first:"2023-12-01" + ~window_last:"2024-12-31" ~year_lo:2022 ~year_hi:2025 ~allow_list_path ~expected_rows:397 + ~expected_bvm_votive:12 ~expected_proper:182 ~expected_common:2 ~expected_preceding_sunday:61 + ~expected_ascension_week:1 + +let suite_2024_2025 = + make_suite ~label:"lms-ordo-2024-2025" ~fixture_path:"fixtures/lms-ordo-2024-2025.sexp" + ~fixture_sha256:"da817b75c5bf40ed3be1d5f6890b199705e02ce4d42111253ab8547bccabc3f7" ~window_first:"2024-11-27" + ~window_last:"2025-12-31" ~year_lo:2023 ~year_hi:2026 ~allow_list_path ~expected_rows:400 + ~expected_bvm_votive:14 ~expected_proper:179 ~expected_common:2 ~expected_preceding_sunday:66 + ~expected_ascension_week:3 + +let suite_2025_2026 = + make_suite ~label:"lms-ordo-2025-2026" ~fixture_path:"fixtures/lms-ordo-2025-2026.sexp" + ~fixture_sha256:"8839a61e0c7d1e6c8326114f4f45a5c183551287a88f4ed01127154add6ae5a5" ~window_first:"2025-11-28" + ~window_last:"2026-12-31" ~year_lo:2024 ~year_hi:2027 ~allow_list_path ~expected_rows:399 + ~expected_bvm_votive:13 ~expected_proper:174 ~expected_common:2 ~expected_preceding_sunday:68 + ~expected_ascension_week:2 |