diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/test_colitur.ml | 2 | ||||
| -rw-r--r-- | test/test_precedence.ml | 76 |
2 files changed, 77 insertions, 1 deletions
diff --git a/test/test_colitur.ml b/test/test_colitur.ml index ae58607..08282e6 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -2,4 +2,4 @@ let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite; - Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite ] + Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite ] diff --git a/test/test_precedence.ml b/test/test_precedence.ml new file mode 100644 index 0000000..39be06c --- /dev/null +++ b/test/test_precedence.ml @@ -0,0 +1,76 @@ +module P = Colitur_kernel.Precedence +module Cel = Colitur_kernel.Celebration +module S = Colitur_kernel.Slug +module Col = Colitur_kernel.Colour +module D = Colitur_kernel.Date + +type rank = Hi | Lo [@@deriving sexp] +type season = Green [@@deriving sexp] + +let cand ?(origin = P.Sanctoral) ?(status = Cel.Feast) ~rank slug = + { P.cel = Cel.make ~slug:(S.of_string_exn slug) ~rank ~status ~colour:Col.White + ~layer:"base" (); origin } + +let ctx = + { P.date = (match D.make ~year:2026 ~month:7 ~day:15 with Ok d -> d | Error e -> failwith e); + season = Green; weekday = D.Wed } + +(* Band: Hi beats Lo. Temporal breaks a tie in its own favour. *) +let rules = + { P.band = (fun _ c -> (match c.P.cel.Cel.rank with Hi -> 10 | Lo -> 20) + - (match c.P.origin with P.Temporal -> 1 | P.Sanctoral -> 0)); + disposition = + (fun ~winner:_ ~loser -> + match loser.P.cel.Cel.status with + | Cel.Commemoration_only -> P.Commemorate P.Ordinary + | Cel.Feast -> (match loser.P.cel.Cel.rank with + | Hi -> P.Transfer + | Lo -> P.Commemorate P.Ordinary)); + admit = (fun ~observed:_ cs -> List.filteri (fun i _ -> i < 2) cs) } + +let slug_of c = S.to_string c.P.cel.Cel.slug + +let test_highest_band_wins () = + let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria") + ~sanctoral:[ cand ~rank:Hi "big-feast" ] in + Alcotest.(check string) "feast wins" "big-feast" (slug_of r.P.observed) + +let test_temporal_wins_a_tie () = + let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday") + ~sanctoral:[ cand ~rank:Hi "saint" ] in + Alcotest.(check string) "temporal wins tie" "sunday" (slug_of r.P.observed) + +let test_loser_dispositions () = + let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday") + ~sanctoral:[ cand ~rank:Hi "transferable"; cand ~rank:Lo "commemorated" ] in + Alcotest.(check (list string)) "deferred" [ "transferable" ] + (List.map slug_of r.P.deferred); + Alcotest.(check (list string)) "commemorated" [ "commemorated" ] + (List.map (fun (c, _) -> slug_of c) r.P.commemorations) + +(* A commemoration-only entry can never be observed, even at a winning band. *) +let test_commemoration_only_never_observed () = + let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria") + ~sanctoral:[ cand ~rank:Hi ~status:Cel.Commemoration_only "suppressed" ] in + Alcotest.(check string) "feria still observed" "feria" (slug_of r.P.observed); + Alcotest.(check (list string)) "suppressed commemorated" [ "suppressed" ] + (List.map (fun (c, _) -> slug_of c) r.P.commemorations) + +(* Anything the admit limit drops is recorded in `omitted`, never dropped silently. *) +let test_nothing_silently_lost () = + let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday") + ~sanctoral:[ cand ~rank:Lo "a"; cand ~rank:Lo "b"; cand ~rank:Lo "c" ] in + Alcotest.(check int) "two admitted" 2 (List.length r.P.commemorations); + Alcotest.(check int) "one recorded as omitted" 1 (List.length r.P.omitted); + let total = 1 + List.length r.P.commemorations + List.length r.P.deferred + + List.length r.P.omitted in + Alcotest.(check int) "every candidate accounted for" 4 total + +let suite = + ( "Precedence", + [ Alcotest.test_case "highest band wins" `Quick test_highest_band_wins; + Alcotest.test_case "temporal wins a tie" `Quick test_temporal_wins_a_tie; + Alcotest.test_case "loser dispositions" `Quick test_loser_dispositions; + Alcotest.test_case "commemoration-only never observed" `Quick + test_commemoration_only_never_observed; + Alcotest.test_case "nothing silently lost" `Quick test_nothing_silently_lost ] ) |