summaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-11 19:07:11 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-11 19:07:11 +0200
commit19d5bbaab8fbf40f6fa6de8906169e3bb7144e1f (patch)
tree0dcc72d79de4b4f68b19dc1d2934fef04887e1e3 /test
parent8ab24da337a10993b98696df5d499706318beb8e (diff)
downloadcolitur-19d5bbaab8fbf40f6fa6de8906169e3bb7144e1f.tar.gz
colitur-19d5bbaab8fbf40f6fa6de8906169e3bb7144e1f.zip
kernel(precedence): rite-parameterised resolver
Three rite-supplied functions, not one: band (who wins, RG 91), disposition (what happens to the loser, RG 92-95) and admit (how many commemorations are admitted, RG 111). The loser's fate depends on the loser's own rank, so conflating them would resist extension. resolve takes the temporal candidate separately from the sanctoral list, which makes it total by construction. Every candidate lands in exactly one of observed, commemorations, deferred or omitted -- nothing is dropped silently, which is what makes the no-celebration-lost invariant checkable.
Diffstat (limited to 'test')
-rw-r--r--test/test_colitur.ml2
-rw-r--r--test/test_precedence.ml76
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 ] )