diff options
Diffstat (limited to 'test/test_litcal_of.ml')
| -rw-r--r-- | test/test_litcal_of.ml | 268 |
1 files changed, 268 insertions, 0 deletions
diff --git a/test/test_litcal_of.ml b/test/test_litcal_of.ml new file mode 100644 index 0000000..1144859 --- /dev/null +++ b/test/test_litcal_of.ml @@ -0,0 +1,268 @@ +(* 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. + + `rite_of` is deliberately not wired into `Colitur_kernel.Rite.t` or the + CLI yet (Phase 2's own work) -- this file calls + {!Rite_of.Temporal_of.temporal} directly, exactly as test_temporal_of.ml + already does, over the SAME civil-date window the fixture covers + (2023-12-03..2035-12-01), no {!Colitur_kernel.Calendar}/{!Colitur_kernel + .Layer} involved. + + SCOPE: season and Ordinary Time week only -- the two fields the fixture + carries. Rank/colour/named-day identity are out of scope for this + layer (Phase 1 has no sanctoral data to compare them against, and + litcal's own [grade_lcl]/[name] are read here only to CLASSIFY why a + week is unwitnessed, never compared against a colitur rank). *) + +module V = Rite_of.Vocab_of +module T = Rite_of.Temporal_of +module D = Colitur_kernel.Date + +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" + +(* ---------------------------------------------------------------------- *) +(* 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); + List.iter + (fun e -> if not (String.equal e.id "L1") then Alcotest.failf "unknown allow-list entry %s (only L1 is used)" e.id) + allow_list + +(* 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 + +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 + ] ) |