diff options
Diffstat (limited to 'test/test_calendar.ml')
| -rw-r--r-- | test/test_calendar.ml | 63 |
1 files changed, 60 insertions, 3 deletions
diff --git a/test/test_calendar.ml b/test/test_calendar.ml index a3c4125..d34611a 100644 --- a/test/test_calendar.ml +++ b/test/test_calendar.ml @@ -68,7 +68,12 @@ module Fixture = struct let disposition ~winner:_ ~(loser : rank P.candidate) = match loser.P.cel.Cel.rank with Lo -> P.Commemorate P.Ordinary | Hi -> P.Transfer - let rules : (season, rank) P.rules = { P.band; disposition; admit = (fun ~observed:_ cs -> cs) } + (* Admits at most one commemoration -- mirrors test_precedence.ml's own + example and, unlike "admit everything", actually gives the accounting + test below a genuine Precedence-native omission (distinct from a + deferred one) to exercise. *) + let rules : (season, rank) P.rules = + { P.band; disposition; admit = (fun ~observed:_ cs -> List.filteri (fun i _ -> i < 1) cs) } let rite : (season, rank) Rite.t = { Rite.id = "synthetic-calendar"; vocab; year_start; temporal; anchors = (fun _ -> []); @@ -82,7 +87,23 @@ module Fixture = struct let big_feast = entry ~month:12 ~day:8 ~slug:"big-feast" ~rank:Hi let commem_worthy = entry ~month:12 ~day:15 ~slug:"commem-worthy" ~rank:Lo - let layer = Layer.of_entries ~id:"synthetic" ~name:"Synthetic sanctoral" [ big_feast; commem_worthy ] + (* 20 Dec: four sanctoral entries on one date, for the full-accounting test. + "day-winner" and "eclipsed" tie on band (both Hi, both Sanctoral); ties + break on slug, so "day-winner" wins and "eclipsed" -- a Hi-rank loser -- + is [Transfer]-disposed, landing in [deferred]. "loser-a" and "loser-b" + are both Lo, both [Commemorate]-disposed, but [admit] only keeps one: + the other lands in Precedence's own [omitted] ("admission limit + reached"), distinct from "eclipsed"'s deferred reason. Four candidates, + three different fates -- observed, one specific omission reason, two + more. *) + let day_winner = entry ~month:12 ~day:20 ~slug:"day-winner" ~rank:Hi + let eclipsed = entry ~month:12 ~day:20 ~slug:"eclipsed" ~rank:Hi + let loser_a = entry ~month:12 ~day:20 ~slug:"loser-a" ~rank:Lo + let loser_b = entry ~month:12 ~day:20 ~slug:"loser-b" ~rank:Lo + + let layer = + Layer.of_entries ~id:"synthetic" ~name:"Synthetic sanctoral" + [ big_feast; commem_worthy; day_winner; eclipsed; loser_a; loser_b ] let liturgical_year_of date = let cy = D.year date in @@ -159,6 +180,41 @@ let test_day_near_domain_floor_does_not_raise () = Alcotest.(check string) "observed is the day's own feria" (Sl.to_string (Fixture.office date).Cel.slug) (Sl.to_string d.LD.observed.Cel.slug) +(* Full-day accounting through the whole Calendar pipeline (Layer -> Calendar + -> Liturgical_day), not just Precedence in isolation: every candidate fed + in for 20 Dec 2026 -- the feria plus Fixture's four colliding sanctoral + entries -- appears exactly once across observed/commemorations/omitted. + Checked as a slug SET (Alcotest.slist), matching test_precedence.ml's own + "nothing silently lost" test: a length-only check would pass even if one + slug were duplicated into two buckets and another dropped, which this + project has shipped before (register finding). *) +let test_full_day_accounting () = + let date = mk 2026 12 20 in + let d = C.day Fixture.rite Fixture.layer date in + let feria_slug = Sl.to_string (Fixture.office date).Cel.slug in + let bucketed = + (Sl.to_string d.LD.observed.Cel.slug + :: List.map (fun (c, _) -> Sl.to_string c.Cel.slug) d.LD.commemorations) + @ List.map (fun (c, _) -> Sl.to_string c.Cel.slug) d.LD.omitted + in + Alcotest.(check (slist string compare)) "every candidate appears exactly once" + [ feria_slug; "day-winner"; "eclipsed"; "loser-a"; "loser-b" ] + bucketed; + (* Identity within [omitted], not just membership: "eclipsed" (a deferred + transfer candidate, RG 96-98) must carry the deferred reason, not + Precedence's native "admission limit reached" that "loser-a"/"loser-b" + -- the ones Precedence itself dropped -- carry. Without this, a bug + that folded [resolution.deferred] into [omitted] with the wrong reason, + or dropped [resolution.omitted]'s own reasons, would still pass the + slug-set check above. *) + let reason_of slug = + d.LD.omitted |> List.find (fun (c, _) -> Sl.to_string c.Cel.slug = slug) |> snd + in + Alcotest.(check string) "eclipsed carries the deferred reason" + "deferred: transfer placement not yet implemented (Task 6)" (reason_of "eclipsed"); + Alcotest.(check string) "loser-a carries Precedence's own admission-limit reason" + "omitted: admission limit reached" (reason_of "loser-a") + let suite = ( "Calendar", [ Alcotest.test_case "year covers every day" `Quick test_year_covers_every_day; @@ -169,4 +225,5 @@ let suite = test_lower_ranked_sanctoral_is_commemorated; Alcotest.test_case "year 9999 does not raise" `Quick test_year_9999_does_not_raise; Alcotest.test_case "day near the domain floor does not raise" `Quick - test_day_near_domain_floor_does_not_raise ] ) + test_day_near_domain_floor_does_not_raise; + Alcotest.test_case "full day accounting" `Quick test_full_day_accounting ] ) |