1 files changed, 108 insertions, 0 deletions
diff --git a/test/test_precedence.ml b/test/test_precedence.ml
new file mode 100644
index 0000000..369c490
--- /dev/null
+++ b/test/test_precedence.ml
@@ -0,0 +1,108 @@
+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
+   -- and each input candidate lands in exactly one bucket, not zero or two. *)
+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
+  let bucketed =
+    (slug_of r.P.observed
+     :: List.map (fun (c, _) -> slug_of c) r.P.commemorations)
+    @ List.map slug_of r.P.deferred
+    @ List.map (fun (c, _) -> slug_of c) r.P.omitted
+  in
+  Alcotest.(check (slist string compare)) "every candidate appears exactly once"
+    [ "a"; "b"; "c"; "sunday" ] bucketed;
+  Alcotest.(check int) "two admitted" 2 (List.length r.P.commemorations)
+
+(* The result must not depend on the order sanctoral candidates arrive in;
+   ties break on slug, not on list position. *)
+let test_order_independent () =
+  let a = cand ~rank:Lo "a" and b = cand ~rank:Lo "b" and c = cand ~rank:Lo "c" in
+  let t = cand ~origin:P.Temporal ~rank:Hi "sunday" in
+  let observed_for sanctoral = slug_of (P.resolve rules ctx ~temporal:t ~sanctoral).P.observed in
+  let comms_for sanctoral =
+    List.map (fun (x, _) -> slug_of x) (P.resolve rules ctx ~temporal:t ~sanctoral).P.commemorations
+  in
+  List.iter
+    (fun perm ->
+      Alcotest.(check string) "same observed" (observed_for [ a; b; c ]) (observed_for perm);
+      Alcotest.(check (list string)) "same commemorations" (comms_for [ a; b; c ]) (comms_for perm))
+    [ [ c; b; a ]; [ b; a; c ]; [ c; a; b ] ]
+
+(* The case the "pass temporal separately" design exists to make safe: a day
+   with no sanctoral candidate at all. *)
+let test_temporal_only_day () =
+  let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria")
+            ~sanctoral:[] in
+  Alcotest.(check string) "feria observed" "feria" (slug_of r.P.observed);
+  Alcotest.(check int) "no commemorations" 0 (List.length r.P.commemorations);
+  Alcotest.(check int) "nothing deferred" 0 (List.length r.P.deferred);
+  Alcotest.(check int) "nothing omitted" 0 (List.length r.P.omitted)
+
+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;
+      Alcotest.test_case "order independent" `Quick test_order_independent;
+      Alcotest.test_case "temporal-only day" `Quick test_temporal_only_day ] )