diff options
Diffstat (limited to 'test/test_rite_ef.ml')
| -rw-r--r-- | test/test_rite_ef.ml | 265 |
1 files changed, 265 insertions, 0 deletions
diff --git a/test/test_rite_ef.ml b/test/test_rite_ef.ml new file mode 100644 index 0000000..c150a6d --- /dev/null +++ b/test/test_rite_ef.ml @@ -0,0 +1,265 @@ +(* Coordinator review (Task 11 fix round): integration tests wiring + [Rite_ef.context] together with the REAL data/ef/sanctoral.sexp + + data/ef/adjustments.sexp through [Colitur_kernel.Calendar] -- the same + pipeline `colitur day` uses, proven here at the OCaml level so these + properties are pinned by the test suite, not merely observable in CLI + output (which is exactly what finding 3 flagged: with the overlay's one + directive replaced by [()], `colitur day 2026`'s stdout is byte-identical + for all 365 days, since [ef-nativity-vigil] always outranks + [vigil-of-christmas] regardless -- the suppression's only observable + effect is on [Liturgical_day.omitted], which no cram assertion reads). *) + +module Cal = Colitur_kernel.Calendar +module Layer = Colitur_kernel.Layer +module Overlay = Colitur_kernel.Overlay +module LD = Colitur_kernel.Liturgical_day +module Slug = Colitur_kernel.Slug +module Date = Colitur_kernel.Date +module Date_spec = Colitur_kernel.Date_spec +module Cel = Colitur_kernel.Celebration +module Colour = Colitur_kernel.Colour +module Subject = Colitur_kernel.Subject +module P = Colitur_kernel.Precedence +module Comp = Colitur_kernel.Computus +module V = Rite_ef.Vocab_ef +module T = Rite_ef.Temporal_ef +module PE = Rite_ef.Precedence_ef + +(* Relative to this test's own build directory (_build/default/test/), same + convention test_sanctoral_ef.ml uses -- test/dune declares both as deps + of the (test ...) stanza. *) +let sanctoral_path = "../data/ef/sanctoral.sexp" +let adjustments_path = "../data/ef/adjustments.sexp" + +let mk y m d = match Date.make ~year:y ~month:m ~day:d with Ok t -> t | Error e -> failwith e + +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 slug_of (c : V.rank Cel.t) = Slug.to_string c.Cel.slug + +(* Finding 3: the suppression's ONLY observable effect is on 24 December's + [omitted] (and, belt-and-braces, on every OTHER field of every OTHER day + too -- vigil-of-christmas must not surface anywhere at all, since the + overlay removes it from the layer before resolution ever runs, unlike an + ordinary occurrence loss). Mutation-verified (see the task report): + substituting `(directives ())` for the real overlay makes this test's + first assertion fail (24 December's [omitted] gains + "vigil-of-christmas"), and confirmed the whole cram suite (test/cli.t) + still passes under that same mutation -- so this closes the "removing + the deliverable breaks no test" gap the coordinator flagged, which cram + alone structurally cannot. *) +let test_vigil_of_christmas_suppressed () = + let layer = real_layer () in + let days = Cal.year Rite_ef.context layer 2026 in + let christmas_eve = + Array.to_list days |> List.find (fun d -> Date.compare d.LD.date (mk 2026 12 24) = 0) + in + Alcotest.(check string) "ef-nativity-vigil is still the observed day" "ef-nativity-vigil" + (slug_of christmas_eve.LD.observed); + Alcotest.(check (list string)) + "24 December has nothing omitted -- vigil-of-christmas never enters the RG91 contest at all" + [] + (List.map (fun (c, _) -> slug_of c) christmas_eve.LD.omitted); + let appears_anywhere = + Array.to_list days + |> List.exists (fun d -> + let is_it c = slug_of c = "vigil-of-christmas" in + is_it d.LD.observed + || List.exists (fun (c, _) -> is_it c) d.LD.commemorations + || List.exists (fun (c, _) -> is_it c) d.LD.omitted + || (match d.LD.transferred_in with Some c -> is_it c | None -> false) + || List.exists (fun (c, _) -> is_it c) d.LD.transferred_out) + in + Alcotest.(check bool) "vigil-of-christmas appears NOWHERE in the resolved year" false + appears_anywhere + +(* Coordinator review, finding 2, reproduced through the project's OWN + extension path (an overlay), the same way the reviewer found it: adding + an I-class feast on 25 December (competing against, and losing to, the + real Nativity) forces an RG 96 search starting 26 December -- which, with + the real sanctoral data (Stephen/John/the Innocents, all II class) plus + the temporal cycle's own Nativity-octave-day entries (29-31 Dec, also II + class), is blocking every single day through 31 December 9999. Before the + domain-ceiling fix this raised (Computus: year 10000 out of range); + confirmed by mutation-testing at the precedence_ef.ml unit level (see the + task report) -- this is the same defect reproduced end to end, through + Calendar, with real data, exactly as the review found it. *) +let test_transfer_search_does_not_raise_at_domain_ceiling () = + let layer = real_layer () in + let impeding_entry : V.rank Layer.entry = + { Layer.date = (match Date_spec.fixed ~month:12 ~day:25 with Ok d -> d | Error e -> failwith e); + cel = + Cel.make ~slug:(Slug.of_string_exn "test-domain-ceiling-impeder") ~rank:V.Class1 + ~colour:Colour.White ~layer:Rite_ef.Precedence_ef.universal_layer () } + in + let overlay : V.rank Overlay.t = + { Overlay.id = "test-domain-ceiling"; directives = [ Overlay.Add impeding_entry ] } + in + let layer, _diagnostics = Overlay.apply layer overlay in + (* Must not raise -- the whole point of the fix. *) + let days = Cal.year Rite_ef.context layer 9999 in + Alcotest.(check bool) "year 9999 resolves without raising, even with an impeded Christmas Day" + true (Array.length days > 0); + let impeder_placed_or_recorded = + Array.to_list days + |> List.exists (fun d -> + slug_of d.LD.observed = "test-domain-ceiling-impeder" + || List.exists (fun (c, _) -> slug_of c = "test-domain-ceiling-impeder") d.LD.omitted) + in + Alcotest.(check bool) "the impeding candidate is accounted for (observed somewhere, or omitted \ + with a recorded reason) -- never silently dropped" + true impeder_placed_or_recorded + +(* Task 11's re-review finding, closed here: [Precedence_ef.transfer_target]'s + Annunciation/Easter condition (and, more generally, RG 96's whole "not I or + II class" test) is correct only because [Temporal_ef] happens to make + every day from Easter Sunday through Low Sunday (Easter+0..+7) blocking -- + Easter itself and Low Sunday via [named], every day between via + [privileged_feria]. Nothing in the type system enforces that; a future + edit narrowing [privileged_feria]'s Easter-octave range would silently let + the RG 96 walk land a translated feast inside the octave. This tests the + CONSEQUENCE (no day in that window ever receives one), not the mechanism + ([privileged_feria] itself), so it stays sensitive to any way that + consequence could break, not only the one code path that currently + protects it. *) + +let easter_offset (d : Date.t) = + let easter = Comp.gregorian_easter (Date.year d) in + Date.to_rata d - Date.to_rata easter + +let in_easter_octave d = let off = easter_offset d in off >= 0 && off <= 7 + +(* 2005-2050: the project's own differential-testing window (CLAUDE.md), + reused here as a deterministic, non-trivial sample -- 46 liturgical years, + each with several genuine transfers (All Souls onto a Sunday, impeded + universal feasts, and so on; test_precedence_ef.ml's own 21k-day manual + review already confirmed "all 7 slugs that ever transfer have a verified + rubrical cause" over a similar span), so this is not a vacuous sweep over + years where nothing ever transfers. *) +let sample_years = + let rec range a b = if a > b then [] else a :: range (a + 1) b in + range 2005 2050 + +(* Property 1: no day in the resolved output, across the whole sample, is + EVER a transfer's landing point inside [Easter, Easter+7] -- checked two + ways. [transferred_out]'s own recorded target is what [transfer_target] + itself returned (calendar.ml's [assignment], stored verbatim), so this is + the more direct signal; [transferred_in] is also checked, in case some + future Calendar change ever let the two disagree. *) +let test_no_transfer_lands_in_easter_octave () = + let layer = real_layer () in + let violations = ref [] in + List.iter + (fun y -> + let days = Cal.year Rite_ef.context layer y in + Array.iter + (fun (d : (V.season, V.rank) LD.t) -> + (match d.LD.transferred_in with + | Some c when in_easter_octave d.LD.date -> + violations := + (Printf.sprintf "%s transferred_in on %s (Easter+%d)" (slug_of c) + (Date.to_iso8601 d.LD.date) (easter_offset d.LD.date)) + :: !violations + | _ -> ()); + List.iter + (fun (c, target) -> + if in_easter_octave target then + violations := + Printf.sprintf "%s transferred_out from %s to %s (Easter+%d)" (slug_of c) + (Date.to_iso8601 d.LD.date) (Date.to_iso8601 target) (easter_offset target) + :: !violations) + d.LD.transferred_out) + days) + sample_years; + Alcotest.(check (list string)) + "no day in [Easter, Easter+7] is ever a transfer's target, 2005-2050" [] (List.rev !violations) + +(* Property 2, and the LIVE case: [PE.transfer_target] called directly, with + an origin that genuinely starts the search INSIDE Holy Week -- Holy + Thursday 2026 (Easter - 3), a date no real sanctoral entry in + data/ef/sanctoral.sexp occupies (Holy Week carries none), so this is + deliberately constructed, not found. [occupant] is the REAL + [Temporal_ef.temporal] (not a synthetic stand-in), so the search is driven + by the actual blocking shape [privileged_feria] produces, not a + hand-picked one -- this is genuinely live: search_from walks origin+1 + (Good Friday, Easter-2) forward through every remaining day of Holy Week, + all of Easter through Low Sunday (Easter+0..+7, all Class1), and only + stops at Easter+8 (the Monday after Low Sunday), which [named] and + [ferial_rank]/[privileged_feria] agree is Class4 -- confirmed below by + checking the OCCUPANT's own rank there, not asserted blind. Without an + origin inside the window itself, [search_from] could stop before ever + reaching it and this test would prove nothing (the vacuity trap the task + brief names explicitly) -- [test_search_genuinely_enters_the_window] pins + that it does not stop early. *) +let holy_week_origin_2026 = + let easter_2026 = Comp.gregorian_easter 2026 in + Date.add_days easter_2026 (-3) + +let real_occupant d = (T.temporal d).Colitur_kernel.Temporal.office + +let test_transfer_target_skips_the_whole_easter_octave () = + let easter_2026 = Comp.gregorian_easter 2026 in + let c = + { P.cel = + Cel.make ~slug:(Slug.of_string_exn "test-impeded-in-holy-week") ~rank:V.Class1 + ~colour:Colour.White ~subject:Subject.Temporal ~layer:PE.universal_layer (); + origin = P.Sanctoral } + in + let target = PE.transfer_target c holy_week_origin_2026 real_occupant in + Alcotest.(check string) "lands on Easter + 8 (Monday after Low Sunday), past the entire octave" + (Date.to_iso8601 (Date.add_days easter_2026 8)) (Date.to_iso8601 target); + Alcotest.(check bool) "strictly after origin (rite.mli's own obligation)" true + (Date.compare target holy_week_origin_2026 > 0); + Alcotest.(check bool) "not inside [Easter, Easter+7]" false + (let off = Date.to_rata target - Date.to_rata easter_2026 in + off >= 0 && off <= 7) + +(* The vacuity check itself: proves the search genuinely walked THROUGH the + window rather than [search_from] having some other reason to stop before + it (e.g. an off-by-one that happened to also land past the octave). Reads + the real occupant's own rank at every day from the origin through + Easter+7 and requires every one of them to be blocking (Class1 or + Class2) -- if any single one were not, [search_from] would have stopped + there instead of at Easter+8, and the test above would be passing for the + wrong reason. *) +let test_search_genuinely_enters_the_window () = + let easter_2026 = Comp.gregorian_easter 2026 in + let rec days_from a b = if Date.compare a b > 0 then [] else a :: days_from (Date.add_days a 1) b in + let walked = days_from (Date.add_days holy_week_origin_2026 1) (Date.add_days easter_2026 7) in + Alcotest.(check bool) + "every day from origin+1 through Easter+7 (the whole span search_from must cross) is blocking" + true + (List.for_all + (fun d -> + match (real_occupant d).Cel.rank with V.Class1 | V.Class2 -> true | V.Class3 | V.Class4 -> false) + walked); + Alcotest.(check bool) + "the walked span is at least 8 days -- the octave alone (Easter..Easter+7), not a one-day hop" + true (List.length walked >= 8) + +let suite = + ( "Rite_ef (real data: overlay-in-effect, domain-ceiling)", + [ Alcotest.test_case "the overlay suppression is observably in effect" `Quick + test_vigil_of_christmas_suppressed; + Alcotest.test_case "RG96 search does not raise at the domain ceiling (real data)" `Quick + test_transfer_search_does_not_raise_at_domain_ceiling; + Alcotest.test_case "no transfer ever lands inside [Easter, Easter+7], 2005-2050" `Quick + test_no_transfer_lands_in_easter_octave; + Alcotest.test_case "transfer_target skips the whole Easter octave from inside Holy Week" `Quick + test_transfer_target_skips_the_whole_easter_octave; + Alcotest.test_case "the search genuinely enters the window (not vacuous)" `Quick + test_search_genuinely_enters_the_window ] ) |