diff options
Diffstat (limited to 'test/test_lms_ordo.ml')
| -rw-r--r-- | test/test_lms_ordo.ml | 467 |
1 files changed, 467 insertions, 0 deletions
diff --git a/test/test_lms_ordo.ml b/test/test_lms_ordo.ml new file mode 100644 index 0000000..c5cae1a --- /dev/null +++ b/test/test_lms_ordo.ml @@ -0,0 +1,467 @@ +(* 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). + + 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. + + 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): + + - 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. + + - 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 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. + + GLORIA is extracted into the 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. + + 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. *) + +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 MF = Colitur_kernel.Mass_formulary +module V = Rite_ef.Vocab_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 + depend on, and this is three lines (test_oracle.ml's own comment). *) +let sha256_of_file path = + let tmp = Filename.temp_file "colitur_lms_ordo_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 real_layer () = + let layer = + match Layer.load V.rank_of_sexp sanctoral_path with + | Ok l -> l + | Error e -> Alcotest.failf "%s: failed to load: %s" sanctoral_path e + in + let overlay = + match Overlay.load V.rank_of_sexp adjustments_path with + | Ok o -> o + | Error e -> Alcotest.failf "%s: failed to load: %s" adjustments_path e + in + let layer, diagnostics = Overlay.apply layer overlay in + Alcotest.(check (list string)) "the committed overlay applies cleanly, no diagnostics" [] + (List.map Overlay.diagnostic_to_string diagnostics); + layer + +let real_lectionary () = + match Colitur_kernel.Lectionary.load "../data/ef/lectionary.sexp" with + | Ok l -> l + | Error e -> Alcotest.failf "../data/ef/lectionary.sexp: failed to load: %s" e + +let real_commons () = + match Rite_ef.Lectionary_ef.Commons.load "../data/ef/commons.sexp" with + | Ok c -> c + | Error e -> Alcotest.failf "../data/ef/commons.sexp: failed to load: %s" e + +(* ---------------------------------------------------------------------- *) +(* The Ordo side: the sexp row, mirrored (not shared -- see this file's *) +(* own header) from tools/extract_lms_ordo.ml's own [row]. *) +(* ---------------------------------------------------------------------- *) + +open Sexplib0.Sexp_conv + +type ordo_row = { + date : string; + weekday : string; + title : string; + formulary_override : string option; + bvm_numeral : string option; + gloria : bool option; + creed : bool option; + has_diocesan_variant : bool; +} +[@@deriving sexp] + +let ordo_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 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. *) +(* ---------------------------------------------------------------------- *) + +type colitur_row = { + c_date : string; + c_season : V.season; + c_formulary : MF.t option; + c_creed : bool; +} + +let colitur_rows () = + 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 + 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 rows = ref [] in + let d = ref (mk 2024 11 27) in + let stop = mk 2025 12 31 in + while Date.compare !d stop <= 0 do + (match Hashtbl.find_opt by_rata (Date.to_rata !d) with + | Some day -> + rows := + { c_date = Date.to_iso8601 day.LD.date; c_season = day.LD.temporal.Colitur_kernel.Temporal.season; + c_formulary = day.LD.formulary; c_creed = day.LD.creed } + :: !rows + | None -> Alcotest.failf "no colitur day resolved for %s" (Date.to_iso8601 !d)); + d := Date.add_days !d 1 + done; + List.rev !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. *) +(* ---------------------------------------------------------------------- *) + +let expected_bvm_numeral season ~month ~day = + match (season : V.season) with + | V.Advent -> "I" + | V.Christmastide -> "II" + | V.Time_after_epiphany when month = 1 || (month = 2 && day <= 2) -> "II" + | V.Time_after_epiphany | V.Septuagesima | V.Lent | V.Passiontide -> "III" + | V.Paschaltide -> "IV" + | V.Time_after_pentecost -> "V" + +(* ---------------------------------------------------------------------- *) +(* data/ef/expected-divergences-lms.sexp -- same shape as *) +(* test_oracle.ml's own [allow_entry]/[load_allow_list]. *) +(* ---------------------------------------------------------------------- *) + +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 + +(* ---------------------------------------------------------------------- *) +(* 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 f -> Colitur_kernel.Slug.to_string f.MF.said + | 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 + let l1_dates = [ "2025-11-03" ] 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 -> () (* Good Friday, see test_creed_coverage *) + | Some ocreed -> + if Bool.equal ocreed c.c_creed then () + else if List.mem o.date l1_dates then + Hashtbl.replace explained_counts "L1" (1 + try Hashtbl.find explained_counts "L1" with Not_found -> 0) + 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 -- *) +(* see this file's own header for why Own_slug is excluded, and Votive is *) +(* covered by the BVM checks above instead. *) +(* ---------------------------------------------------------------------- *) + +let test_formulary_override_by_source () = + let ordo = ordo_rows () in + let colitur = colitur_rows () in + 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 bad = ref [] in + List.iter + (fun (o, c) -> + match c.c_formulary with + | Some { MF.via = MF.Proper; _ } -> + bump "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"; + 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; _ } -> + bump "preceding_sunday"; + if o.formulary_override = None then bad := Printf.sprintf "%s: Preceding_sunday day but Ordo shows no override" o.date :: !bad + | Some { MF.via = MF.Votive; _ } | Some { MF.via = MF.Own_slug; _ } | None -> ()) + pairs; + Alcotest.(check (list string)) "no unexplained formulary-override mismatch on Proper/Common/Preceding_sunday days" + [] (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) + +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 + +let suite = + ( "lms-ordo", + [ 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 "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; + Alcotest.test_case "every Ordo BVM numeral day is a colitur Votive day" `Quick + test_bvm_numeral_implies_votive; + Alcotest.test_case "formulary override matches on Proper/Common/Preceding_sunday days" `Quick + test_formulary_override_by_source; + Alcotest.test_case "the via distribution sums to the full window" `Quick test_via_distribution_totals_400 + ] ) |