diff options
Diffstat (limited to 'test/test_fiuv_ordo.ml')
| -rw-r--r-- | test/test_fiuv_ordo.ml | 268 |
1 files changed, 268 insertions, 0 deletions
diff --git a/test/test_fiuv_ordo.ml b/test/test_fiuv_ordo.ml new file mode 100644 index 0000000..8b3e942 --- /dev/null +++ b/test/test_fiuv_ordo.ml @@ -0,0 +1,268 @@ +(* Witnesses task (2026-08-22-colitur-celebrant-rubrics-phase1): the + SEVENTH validation layer, and the first UNIVERSAL, SECOND-COMPILER + witness -- the FIUV (Foederatio Internationalis Una Voce) Ordo for + 2025-2026, compiled by Joseph Shaw, independent of the Latin Mass + Society's own three editions (test_lms_ordo.ml) except for sharing a + publisher/host (see test/fixtures/fiuv-ordo-2025-2026.sexp's own + provenance header, and docs/research/ordo/PROVENANCE-ordo-corpus.md, + for the full account of what independence this source does and does + not buy). + + WHY THIS LAYER IS MORE VALUABLE THAN THE LMS ONE, per the task brief's + own four reasons: (1) UNIVERSAL -- no diocesan variants to exclude at + all, so this fixture's own [row] carries no [has_diocesan_variant] + field, unlike the LMS one; (2) IN LATIN, the rubrics' own vocabulary; + (3) BOTH DIRECTIONS EXPLICIT ("Gloria"/"sine Gloria", "Credo"/"sine + Credo") -- used here exactly as with the LMS source; (4) RECORDS THE + TE DEUM, the hinge of RG 431(a)'s own Mass-Gloria rule (deferred to + Phase 2, Breviary nn. 237-238) -- captured into the fixture, NOT + compared here (no colitur-side Te Deum predicate exists yet). + + SCOPE: the CREED (RG 475-476, {!Rite_ef.Rubrics_ef.creed}) is the ONE + axis compared against colitur, per the task brief. [praef] and + [te_deum] are captured into the fixture (a genuinely useful data set + for Phase 2/3's still-unbuilt Gloria and preface rules) but + deliberately NOT validated here -- there is nothing on colitur's own + side yet to compare either against. [class_] (raw, including the FIUV + ordo's own explicit "III cl." vs "III cl. (Priv.)" Cum Sanctissima + convention, stated on its own title page) is likewise captured but not + compared: colitur's core is strictly the 1962 Missal with Cum + Sanctissima/Quo Magis modelled only as an OVERLAY, never core + (CLAUDE.md's own binding decision #2), so colitur's UNOVERLAID output + has no Cum-Sanctissima-aware notion of "III cl." vs "(Priv.)" to + compare this field against in the first place -- comparing it would be + comparing the Ordo against a question colitur's default configuration + was never asked. *) + +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 V = Rite_ef.Vocab_ef + +let sanctoral_path = "../data/ef/sanctoral.sexp" +let adjustments_path = "../data/ef/adjustments.sexp" +let fixture_path = "fixtures/fiuv-ordo-2025-2026.sexp" +let allow_list_path = "../data/ef/expected-divergences-fiuv.sexp" + +(* Duplicated, not shared -- test_lms_ordo.ml's own identical function + carries the same "no shared .mli" reasoning. *) +let sha256_of_file path = + let tmp = Filename.temp_file "colitur_fiuv_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 fixture_sha256 = "becadaad43b3a42c4eb820cb4e93d68f9b1c07a2c8e5273167cd599758af5c67" + +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 from tools/extract_fiuv_ordo.ml's *) +(* own [row] -- see this file's own header on why there is no *) +(* [has_diocesan_variant] field here, unlike the LMS mirror. *) +(* ---------------------------------------------------------------------- *) + +open Sexplib0.Sexp_conv + +type ordo_row = { + date : string; + class_ : string option; + title : string; + te_deum : bool option; + gloria : bool option; + credo : bool option; + praef : string option; +} +[@@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 + +let window_first = "2025-11-27" +let window_last = "2026-12-31" + +(* ---------------------------------------------------------------------- *) +(* The colitur side, over the same window -- mirrors test_lms_ordo.ml's *) +(* own [colitur_rows] exactly (a liturgical year straddles two civil *) +(* years, so the resolution walk starts a civil year early and ends one *) +(* late). *) +(* ---------------------------------------------------------------------- *) + +type colitur_row = { c_date : string; 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 = 2024 to 2027 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 s = match Date.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 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_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 + +(* ---------------------------------------------------------------------- *) +(* data/ef/expected-divergences-fiuv.sexp -- same shape as the LMS/ *) +(* missalemeum allow-lists' own [allow_entry]. A SEPARATE file: this Ordo *) +(* is a fourth, independent lineage from all three others already in this *) +(* project. *) +(* ---------------------------------------------------------------------- *) + +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 (2025-11-27..2026-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 + +(* Holy Saturday (2026-04-04) is the ONLY day this fixture shows no Credo + marker for -- confirmed directly against the raw source: unlike the + LMS Ordo (whose "no Mass" day is Good Friday, the 1955-restored Holy + Week having no Mass that day at all), THIS Ordo's Good Friday DOES + carry a Mass rubric ("Missa pr., ... Gloria, sine Credo, praef. + comm."), leaving Holy Saturday as the sole day with no Mass mentioned + at all (its own Vigil Mass is conventionally counted under Easter + Sunday's own date in this source, matching a real, if narrower, + instance of the same "a vigil Mass is dated to the day it anticipates" + convention the LMS characterisation already established). Asserted as + the ONLY such day, not merely observed once: a parsing regression that + swallowed a real row would otherwise silently join this 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.credo = None) ordo in + Alcotest.(check (list string)) "only Holy Saturday has no Ordo Creed marker" [ "2026-04-04" ] + (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" o.date o.title c.c_creed (Option.get o.credo) + +(* Which allow-list id, if any, explains a Creed mismatch on this date -- + date-keyed, not "any declared entry excuses any mismatch", the same + discipline test_lms_ordo.ml's own [allow_list_id_for_date] uses and + for the identical reason: an entry that starts firing on an + UNEXPECTED new date must be visible as a real change, not silently + absorbed. Empty until characterisation found a real divergence to + name. *) +let fiuv_allow_list_id_for_date = ([] : (string * string) list) + +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 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.credo with + | None -> () + | Some ocreed -> + if Bool.equal ocreed c.c_creed then () + else + match List.assoc_opt o.date fiuv_allow_list_id_for_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)) "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; + 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 + +let suite = + ( "fiuv-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 Holy Saturday 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 + ] ) |