From 19d5bbaab8fbf40f6fa6de8906169e3bb7144e1f Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 19:07:11 +0200 Subject: 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. --- test/test_precedence.ml | 76 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) create mode 100644 test/test_precedence.ml (limited to 'test/test_precedence.ml') 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 ] ) -- cgit v1.3 From 7e29712aadf2436b83de2d5e8d1f98b30d2f6d59 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 19:23:06 +0200 Subject: test(precedence): strengthen accounting test, cover order and empty sanctoral The accounting test only checked bucket lengths, which a mutant satisfies by duplicating a candidate across two buckets while dropping another entirely. Replace it with a sorted slug-set comparison (Alcotest.slist), which a duplicate-or-missing slug both fail. Add two cases the brief's three properties call for but nothing exercised: input-order independence (permuting the sanctoral list must not change the outcome) and a temporal-only day (empty sanctoral list), the case the temporal/sanctoral split exists to make safe. --- test/test_precedence.ml | 46 +++++++++++++++++++++++++++++++++++++++------- 1 file changed, 39 insertions(+), 7 deletions(-) (limited to 'test/test_precedence.ml') diff --git a/test/test_precedence.ml b/test/test_precedence.ml index 39be06c..369c490 100644 --- a/test/test_precedence.ml +++ b/test/test_precedence.ml @@ -56,15 +56,45 @@ let test_commemoration_only_never_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. *) +(* 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 - 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 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", @@ -73,4 +103,6 @@ let suite = 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 "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 ] ) -- cgit v1.3