summaryrefslogtreecommitdiff
path: root/test/test_precedence_ef.ml
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-11 23:25:39 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-11 23:25:39 +0200
commit2ad350e0f97a99f76ac1d2d95cfa210f7393c777 (patch)
tree5ff5c9463c4316a974b7559dafe7c650ba4ae37c /test/test_precedence_ef.ml
parent8c6788053dce2a365e3ddf22eccc9c68e641f32e (diff)
downloadcolitur-2ad350e0f97a99f76ac1d2d95cfa210f7393c777.tar.gz
colitur-2ad350e0f97a99f76ac1d2d95cfa210f7393c777.zip
rite(ef): commemoration privilege and admission (RG 108-111)
Precedence_ef.privilege_of classifies a commemoration candidate against RG 109's closed list of privileged commemorations (a Sunday; a I-class day; a day within the Octave of the Nativity; a September Ember day; a feria of Advent, Lent or Passiontide; the Major Rogations in Mass), read entirely off the candidate's own rank/slug/origin, no context needed. Major Rogations (f) is left unimplemented rather than guessed: no producer for the Major Litanies exists anywhere in this codebase yet. disposition's two Commemorate sites now call privilege_of instead of Task 8's interim_privilege placeholder, which is removed entirely (binding and .mli export both gone). Precedence_ef.admit applies RG 111's four admission counts, keyed on the observed day's own class and Sunday-ness: a I-class day admits none except one privileged commemoration; a II-class Sunday admits one, but a privileged commemoration due displaces any ordinary one regardless of dignity; any other II-class day admits one by dignity alone, with no such override; III/IV-class days admit at most two by dignity. Ties break on slug, matching Precedence.compare_by, so the admitted set never depends on input order. Every admitted candidate is a value taken unchanged from the input list, never rebuilt, so Precedence.resolve's physical-equality-based dropped/omitted accounting keeps working -- closing a note left open since Task 2. Tests: RG 109 category rows (one per reachable category, plus boundary rows proving Advent/Lent Ember days and Minor Rogations are correctly excluded), RG 111 admission rows checked on slug identity rather than count, an order-independence check, and three end-to-end integration tests proving the admission limit's drop lands in resolution.omitted rather than vanishing.
Diffstat (limited to 'test/test_precedence_ef.ml')
-rw-r--r--test/test_precedence_ef.ml310
1 files changed, 306 insertions, 4 deletions
diff --git a/test/test_precedence_ef.ml b/test/test_precedence_ef.ml
index 3b2d5f6..f3fd357 100644
--- a/test/test_precedence_ef.ml
+++ b/test/test_precedence_ef.ml
@@ -352,13 +352,25 @@ let disposition_cases =
here with a loser that ALSO carries a Class1 rank and a vigil-suffixed
slug losing to a Sunday, so this row only passes if the
Commemoration_only check is checked BEFORE both RG 33's omission and
- RG 95's transfer, not after. *)
+ RG 95's transfer, not after. Its expected privilege is [Privileged],
+ not [Ordinary]: this loser's [rank] is [Class1] (the default [cand]
+ leaves unless overridden, deliberately kept here for the
+ branch-order proof above), and RG 109(b) (register line 374-375, "of
+ a I-class day") makes any [Class1] commemoration privileged
+ regardless of how it reached [Commemorate] -- Task 8's placeholder
+ [interim_privilege] used to hide this (always [Ordinary]); Task 9's
+ real [privilege_of] does not. This row is also this suite's ONLY
+ witness for RG 109(b): a plain [Feast]-status [Class1] loser never
+ reaches [Commemorate] at all (RG 95 sends it to [Transfer] instead,
+ see the row above), so [Commemoration_only] is the only shape that
+ can exercise it here (see the task report). *)
( "Commemoration_only loser is always Commemorate, even if I-class and \
- vigil-shaped, even losing to a Sunday",
+ vigil-shaped, even losing to a Sunday -- and RG109(b) makes it \
+ privileged",
an_ordinary_sunday,
cand ~origin:P.Sanctoral ~status:Cel.Commemoration_only ~layer:PE.universal_layer
"ef-suppressed-vigil",
- "Commemorate(Ordinary)" );
+ "Commemorate(Privileged)" );
(* Totality: the lower ranks the RG 33/RG 95 branches never touch still
reach the RG 95 "commemorated or omitted" branch, not an
unhandled/exceptional case. *)
@@ -372,6 +384,276 @@ let disposition_cases =
"Commemorate(Ordinary)" )
]
+(* Task 9: [privilege_of]'s RG 109 categories (register lines 374-377),
+ exercised through [PE.disposition]'s [Commemorate] payload -- [privilege_of]
+ itself is private, so this is the only vantage point a test outside
+ precedence_ef.ml has on it. Each row below is built to match ONLY the one
+ category it names (see each row's own comment for why), closing the
+ hazard flagged in the task brief ("a test day that is both a Sunday and a
+ I-class day proves nothing about either"). Category (b), "of a I-class
+ day", already has its sole witness above (the Commemoration_only row):
+ a plain [Feast]-status [Class1] loser can never reach [Commemorate] at
+ all in this ruleset (RG 95 routes it to [Transfer] instead), so no
+ further row for (b) is added here -- see the task report. Category (f),
+ "of the Major Rogations, in Mass", has no row at all: no candidate this
+ codebase can currently construct represents one (see [privilege_of]'s own
+ comment on (f)) -- the negative row below proves the one slug this engine
+ DOES compute that could be mistaken for it (the Minor Rogations) is
+ correctly NOT conflated with it, which is the strongest claim available
+ without inventing an unfounded slug convention. *)
+let privilege_cases =
+ [ (* (a) register line 374: "of a Sunday". [an_ordinary_sunday] is Class2,
+ not Class1, not within the Nativity octave, not an Ember day, not a
+ feria of Advent/Lent/Passiontide -- matches (a) alone. *)
+ ( "(a) an ordinary Sunday commemoration is privileged",
+ cand "ef-nativity",
+ an_ordinary_sunday,
+ "Commemorate(Privileged)" );
+ (* (c) register line 375: "of days within the Octave of the Nativity" --
+ sourced from [Temporal_ef.temporal]'s own output (29 Dec 2026, Class2,
+ "ef-nativity-octave-day-5"), not a hand-typed slug, for the same
+ coupling-safety reason the file's own [of_temporal] rows use it
+ elsewhere. Not a Sunday, not Class1, not an Ember day, not an
+ Advent/Lent/Passiontide feria slug. *)
+ ( "(c) a day within the Nativity octave is privileged",
+ cand "ef-nativity",
+ of_temporal (mk 2026 12 29),
+ "Commemorate(Privileged)" );
+ (* (d) register line 375-376: "of September Ember days" -- 23 Sep 2026 is
+ the September Ember Wednesday (independently derived from
+ [Temporal_ef]'s own third-Sunday-of-September rule: first Sunday of
+ September 2026 is the 6th, +14 days = 20th, +3 = 23rd), sourced from
+ [Temporal_ef.temporal] itself, Class2. Not a Sunday, not Class1, not
+ within the Nativity octave, not an Advent/Lent Ember day (a DIFFERENT
+ Ember set, deliberately excluded by (d) -- see the negative row
+ below), not a plain Advent/Lent/Passiontide feria slug either. *)
+ ( "(d) a September Ember day is privileged",
+ cand "ef-nativity",
+ of_temporal (mk 2026 9 23),
+ "Commemorate(Privileged)" );
+ (* (e) register line 376: "of ferias of Advent, Lent and Passiontide" --
+ two rows, one per season named, both from [Temporal_ef.temporal]'s
+ own generic ferial fallback, neither a Sunday, Ember day, or within
+ the Nativity octave. *)
+ ( "(e) an Advent feria is privileged",
+ cand "ef-nativity",
+ of_temporal (mk 2026 12 1),
+ "Commemorate(Privileged)" );
+ ( "(e) a Lent feria is privileged",
+ cand "ef-nativity",
+ of_temporal (off (-41)),
+ "Commemorate(Privileged)" );
+ (* Negative, RG 109(d) vs (e)'s own boundary: the Advent and Lent Ember
+ sets are ALSO II-class ferias of Advent/Lent by RG 91 (entry 18), and
+ their slugs ("ef-advent-ember-*", "ef-lent-ember-*") share (e)'s own
+ season prefixes -- but RG 109 privileges ONLY the September set (d),
+ leaving these two ordinary. 16 Dec 2026 is the Advent Ember Wednesday
+ (independently derived: Advent I 2026 is 29 Nov, +14 days = 13 Dec,
+ +3 = 16 Dec); the Lent Ember Wednesday is the same date [off (-39)]
+ already used by the entry-18 [band] row above. Both sourced from
+ [Temporal_ef.temporal]. If [privilege_of] relied on the season prefix
+ alone without excluding Ember slugs, both would wrongly come back
+ [Privileged] -- the exact trap this pair of rows guards against. *)
+ ( "boundary: an Advent Ember day is NOT privileged (only September is, \
+ RG109(d))",
+ cand "ef-nativity",
+ of_temporal (mk 2026 12 16),
+ "Commemorate(Ordinary)" );
+ ( "boundary: a Lent Ember day is NOT privileged (only September is, \
+ RG109(d))",
+ cand "ef-nativity",
+ of_temporal (off (-39)),
+ "Commemorate(Ordinary)" );
+ (* Negative, RG 109(f)'s own boundary: the Minor Litanies/Rogations
+ (Monday/Tuesday before Ascension, RG 87 -- [Temporal_ef.temporal]
+ DOES compute these, unlike the Major Litanies RG 109(f) actually
+ names, see [privilege_of]'s own comment) must NOT be mistaken for the
+ Major Rogations RG 109(f) privileges: RG 88 says the Minor Rogations
+ change nothing in the Office at all, so nothing about them is
+ privileged either. *)
+ ( "boundary: a Minor Rogation day is NOT privileged (RG109(f) names \
+ the Major Litanies, not these)",
+ cand "ef-nativity",
+ of_temporal (off 36),
+ "Commemorate(Ordinary)" )
+ ]
+
+(* Task 9: [PE.admit] -- RG 111's admission counts (register line 378),
+ given commemorations ALREADY tagged with their real privilege (as
+ [PE.disposition] now tags them -- see [privilege_cases] above). Every
+ candidate/privilege pair here is built directly, not routed through
+ [PE.disposition], so these rows isolate [admit]'s own selection logic
+ from [privilege_of]'s classification -- the two are proved separately by
+ design (unlike a test that only proves [admit] admits SOME correct-looking
+ set without knowing whether it or [privilege_of] supplied the "correct"
+ part). Checked on slug IDENTITY, not count (the brief: "'two admitted'
+ proves nothing about *which* two"). *)
+
+(* Class2 dignity, tagged [Ordinary] explicitly (not via [privilege_of]) --
+ used as the higher-dignity, non-privileged half of every asymmetry pair
+ below. *)
+let ordinary_hi = cand ~rank:V.Class2 "ef-ordinary-hi"
+
+(* Class3 dignity (LOWER than [ordinary_hi]), tagged [Privileged] explicitly
+ -- pairing a lower-dignity privileged candidate against a higher-dignity
+ ordinary one is what makes the II-class-Sunday-vs-other-II-class
+ asymmetry observable: pure dignity and "privilege wins the slot" pick
+ DIFFERENT winners from this exact pair. *)
+let privileged_lo = cand ~rank:V.Class3 "ef-privileged-lo"
+
+(* Class2 dignity (tied with [ordinary_hi], distinguishing rank from
+ privilege alone), tagged [Privileged] -- the higher-dignity privileged
+ candidate for the "two privileged due" row. *)
+let privileged_hi = cand ~rank:V.Class2 "ef-privileged-hi"
+
+(* Class4, the lowest dignity in play -- the third candidate for the
+ III/IV-class "at most two" row, so which TWO of three survive is the
+ thing under test, not merely how many. *)
+let ordinary_lowest = cand ~rank:V.Class4 "ef-ordinary-lowest"
+
+let observed_class1 = cand "ef-nativity" (* Class1 by [cand]'s own default. *)
+let observed_class2_sunday = an_ordinary_sunday (* Class2, slug carries "-sunday". *)
+let observed_class2_other = cand ~rank:V.Class2 "ef-other-class2-day" (* Class2, no "-sunday". *)
+let observed_class3 = cand ~rank:V.Class3 "ef-some-class3-day"
+
+let slugs_of admitted =
+ List.map (fun (c, _) -> S.to_string c.P.cel.Cel.slug) admitted
+
+let admit_cases =
+ [ (* RG 111 (register line 378): "I class: none save one privileged." *)
+ ( "I-class day, only an ordinary commemoration due -> none admitted",
+ observed_class1,
+ [ (ordinary_hi, P.Ordinary) ],
+ [] );
+ ( "I-class day, ordinary + privileged both due -> only the privileged \
+ one, regardless of the ordinary one's higher dignity",
+ observed_class1,
+ [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged) ],
+ [ "ef-privileged-lo" ] );
+ ( "I-class day, two privileged due -> only the higher-dignity one (still \
+ just \"one\")",
+ observed_class1,
+ [ (privileged_lo, P.Privileged); (privileged_hi, P.Privileged) ],
+ [ "ef-privileged-hi" ] );
+ (* RG 111: "II-class Sundays: one (dropped if a privileged one is due)." *)
+ ( "II-class Sunday, only an ordinary commemoration due -> it is admitted",
+ observed_class2_sunday,
+ [ (ordinary_hi, P.Ordinary) ],
+ [ "ef-ordinary-hi" ] );
+ ( "II-class Sunday, ordinary (higher dignity) + privileged (lower \
+ dignity) both due -> the PRIVILEGED one is admitted, the ordinary \
+ one dropped despite outranking it",
+ observed_class2_sunday,
+ [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged) ],
+ [ "ef-privileged-lo" ] );
+ (* RG 111: "other II class: one" -- no privilege override, the exact
+ asymmetry the brief and precedence_ef.ml's own [admit] comment flag:
+ same candidate pair as the II-class-Sunday row above, OPPOSITE
+ observed day, OPPOSITE winner. *)
+ ( "other II-class day, only an ordinary commemoration due -> it is \
+ admitted",
+ observed_class2_other,
+ [ (ordinary_hi, P.Ordinary) ],
+ [ "ef-ordinary-hi" ] );
+ ( "other II-class day, same ordinary+privileged pair as the Sunday row \
+ above -> the ORDINARY one wins on pure dignity this time, the \
+ privileged one dropped",
+ observed_class2_other,
+ [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged) ],
+ [ "ef-ordinary-hi" ] );
+ (* RG 111: "III-IV class: at most two" -- three candidates due, top two
+ by dignity admitted, the third (lowest dignity) dropped. *)
+ ( "III-class day, three commemorations due -> the top two by dignity, \
+ not merely \"two of them\"",
+ observed_class3,
+ [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged);
+ (ordinary_lowest, P.Ordinary) ],
+ [ "ef-ordinary-hi"; "ef-privileged-lo" ] )
+ ]
+
+(* Order independence (brief: "the admitted set must not depend on input
+ order"): the SAME three candidates as the III-class row above, passed in
+ the reverse order, must still admit the same top two -- exercised on this
+ row specifically because it is the one where the sort actually has work
+ to do (three distinct dignities, a real top-2 cut), unlike a
+ two-candidate row where either order already happens to be sorted. *)
+let test_admit_order_independent () =
+ let comms =
+ [ (ordinary_hi, P.Ordinary); (privileged_lo, P.Privileged); (ordinary_lowest, P.Ordinary) ]
+ in
+ let forward = slugs_of (PE.admit ~observed:observed_class3 comms) in
+ let reversed = slugs_of (PE.admit ~observed:observed_class3 (List.rev comms)) in
+ Alcotest.(check (list string)) "reversed input admits the same candidates"
+ forward reversed
+
+(* The brief: "a case proving that what the limit drops is reported in
+ omitted rather than vanishing" -- three end-to-end proofs, wired with the
+ REAL [PE.band], [PE.disposition] and [PE.admit] together (not a stub, so
+ [privilege_of]'s real classification is exercised too, not just [admit]'s
+ selection logic in isolation as above).
+
+ [rules] deliberately reused, not rebuilt per test, since it is always the
+ same three real functions. *)
+let real_rules = { P.band = PE.band; disposition = PE.disposition; admit = PE.admit }
+
+(* I-class day, zero admitted: the strongest form of "does not vanish" --
+ EVERY commemoration due is dropped (RG 111: "none save one privileged",
+ and the one loser here is ordinary), yet it must still appear in
+ [omitted], not merely be absent from [commemorations]. *)
+let test_i_class_day_drops_into_omitted () =
+ let date = mk 2026 12 25 in
+ let day_ctx = ctx date in
+ let nativity = of_temporal date in
+ let saint = cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-some-saint-3" in
+ let resolution = P.resolve real_rules day_ctx ~temporal:nativity ~sanctoral:[ saint ] in
+ Alcotest.(check (list string)) "nothing admitted on a I-class day with only an ordinary loser due"
+ [] (List.map (fun (c, _) -> S.to_string c.P.cel.Cel.slug) resolution.P.commemorations);
+ Alcotest.(check (list (pair string string))) "the ordinary loser is reported omitted, not vanished"
+ [ ("ef-some-saint-3", "omitted: admission limit reached") ]
+ (List.map (fun (c, reason) -> (S.to_string c.P.cel.Cel.slug, reason)) resolution.P.omitted)
+
+(* II-class Sunday, two ordinary losers due, RG 111's "one" admits the
+ higher-dignity one and drops the other into [omitted]. *)
+let test_ii_class_sunday_drops_second_loser_into_omitted () =
+ let date = mk 2025 11 9 (* an ordinary Time-after-Pentecost Sunday, not All Souls-adjacent. *) in
+ let day_ctx = ctx date in
+ let sunday =
+ { P.cel =
+ Cel.make ~slug:(S.of_string_exn "ef-time-after-pentecost-sunday-x") ~rank:V.Class2
+ ~colour:Col.Green ~subject:Sub.Temporal ~layer:"temporal" ();
+ origin = P.Temporal }
+ in
+ let saint_a = cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "ef-some-saint" in
+ let saint_b = cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-some-saint-3" in
+ let resolution = P.resolve real_rules day_ctx ~temporal:sunday ~sanctoral:[ saint_a; saint_b ] in
+ Alcotest.(check (list string)) "only the higher-dignity (Class2) loser is admitted"
+ [ "ef-some-saint" ]
+ (List.map (fun (c, _) -> S.to_string c.P.cel.Cel.slug) resolution.P.commemorations);
+ Alcotest.(check (list (pair string string))) "the lower-dignity loser is reported omitted, not vanished"
+ [ ("ef-some-saint-3", "omitted: admission limit reached") ]
+ (List.map (fun (c, reason) -> (S.to_string c.P.cel.Cel.slug, reason)) resolution.P.omitted)
+
+(* A genuinely privileged commemoration reaching [admit] through the REAL
+ pipeline (register RG 109(e)): a Lent feria (Class3, temporal-origin)
+ loses to a universal Class2 sanctoral feast on the same date, and
+ [PE.disposition] tags it [Privileged] via [privilege_of] -- proving
+ [privilege_of] and [admit] cooperate correctly end-to-end, not merely in
+ the hand-tagged unit tests above. *)
+let test_privileged_lent_feria_admitted_end_to_end () =
+ let date = off (-41) (* Lent I Monday, the same date the entry-22 [band] row uses. *) in
+ let day_ctx = ctx date in
+ let lent_feria = of_temporal date in
+ let saint = cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "ef-some-saint" in
+ let resolution = P.resolve real_rules day_ctx ~temporal:lent_feria ~sanctoral:[ saint ] in
+ Alcotest.(check string) "the Lent feast wins the day, not the sanctoral feast's own commemoration"
+ "ef-some-saint" (S.to_string resolution.P.observed.P.cel.Cel.slug);
+ Alcotest.(check (list (pair string string))) "the Lent feria is admitted, tagged Privileged"
+ [ ("ef-lent-1-monday", "Privileged") ]
+ (List.map
+ (fun (c, p) -> (S.to_string c.P.cel.Cel.slug, match p with P.Privileged -> "Privileged" | P.Ordinary -> "Ordinary"))
+ resolution.P.commemorations);
+ Alcotest.(check int) "nothing omitted" 0 (List.length resolution.P.omitted)
+
(* Completes Task 7's carried fix (register line 334): on a real Sunday
landing on 2 November, All Souls does not merely lose (that was Task 7's
[band] fix, proved by [test_all_souls_yields_to_sunday] above) -- it must
@@ -426,7 +708,27 @@ let suite =
Alcotest.(check string) desc expect
(string_of_disposition (PE.disposition ~winner ~loser))))
disposition_cases
+ @ List.map
+ (fun (desc, winner, loser, expect) ->
+ Alcotest.test_case desc `Quick (fun () ->
+ Alcotest.(check string) desc expect
+ (string_of_disposition (PE.disposition ~winner ~loser))))
+ privilege_cases
@ [ Alcotest.test_case "All Souls disposition is Transfer" `Quick
test_all_souls_disposition_is_transfer;
Alcotest.test_case "All Souls transfers end-to-end (resolve, real rules)" `Quick
- test_all_souls_transfers_end_to_end ] )
+ test_all_souls_transfers_end_to_end ]
+ @ List.map
+ (fun (desc, observed, comms, expect) ->
+ Alcotest.test_case desc `Quick (fun () ->
+ Alcotest.(check (list string)) desc expect
+ (slugs_of (PE.admit ~observed comms))))
+ admit_cases
+ @ [ Alcotest.test_case "admit is order-independent (III-class, 3 candidates)" `Quick
+ test_admit_order_independent;
+ Alcotest.test_case "I-class day: full drop reported in omitted, not vanished" `Quick
+ test_i_class_day_drops_into_omitted;
+ Alcotest.test_case "II-class Sunday: second loser dropped into omitted" `Quick
+ test_ii_class_sunday_drops_second_loser_into_omitted;
+ Alcotest.test_case "RG109(e) Lent feria privileged end-to-end" `Quick
+ test_privileged_lent_feria_admitted_end_to_end ] )