summaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-26 12:29:17 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-26 12:29:17 +0200
commite6cb5937be7f009eab11f3cf85205d1fde25eb48 (patch)
treefb10d57e8a5b124e022eb1f748a5dde31a93736b /test
parente199ad6f599a263cad1f9886b512da8b3a46f465 (diff)
downloadcolitur-e6cb5937be7f009eab11f3cf85205d1fde25eb48.tar.gz
colitur-e6cb5937be7f009eab11f3cf85205d1fde25eb48.zip
test(of): validation layers -- Layer 2 properties, litcal grade/identity, golden pins
Task 6 (2026-08-25-colitur-of-phases-3-5), the final task of OF Phases 3-5. Layer 2 (test/test_validate_of.ml, new): Colitur_kernel.Validate.run against the real, assembled Rite_of.context -- landmark years, the 9999 domain edge, a 200-year QCheck sample, and the full 8417-year exhaustive sweep under COLITUR_EXHAUSTIVE_SWEEP=1, all filtered through the same three pinned-not-fixed gaps test_rite_of.ml already names (Normae n.35(a) Holy Family fallback, the 25-December lectionary gap, St Joseph/Palm Sunday), duplicated verbatim rather than shared so this file's own filtering cannot drift from Task 5's silently. Two dedicated 200-sample properties confirm Ordinary Time weeks are 1..34 with the final week always 34, and Calendar.year covers its own liturgical year exactly once with no gaps, both through the resolved pipeline (a genuinely different code path from Phase 1's own already-exhaustive Temporal_of-level property). An early version folded a second Calendar.year pass into the exhaustive loop for these two properties too and measured ~365s for that alone (a scratch timing harness, not committed); dropped in favour of one Val.run-only exhaustive loop (~200s), matching the EF harness's shape (one property, one sweep) rather than tripling it. test/test_litcal_of.ml extended beyond season/week to GRADE (litcal's own grade_lcl bucketed against the real Tabula band Precedence_of.band assigns the day's observed office) and IDENTITY (observed slug against a hand-verified event_key -> slug table for the closed 46-entity FIXED/ NAMED set -- deliberately not the numbered Sunday/weekday series, a stated, counted scope limit). Both follow the counted-and-allow-listed discipline: 1800/4346 rows compared for grade (1763 match, 37 allow- listed across 5 new entries), 508/4346 for identity (505 match, 3 allow- listed across 3 new entries), zero unexplained either way. Real divergences found and adjudicated, not suppressed: litcal's own grade vocabulary conflates Tabula I.2/I.3 for Trinity/Corpus Christi (verdict colitur); litcal's Mary Magdalene data predates the 2016 CDW decree (verdict litcal); a genuine, unadjudicated Sacred-Heart/Nativity-of-John- the-Baptist tie-break at equal band, found live at the one Easter date in this fixture's window that creates it (verdict open, no citation found either way); a second instance of precedence_of.mli's own documented forward-only transfer_target limitation, on a date shape the mli's own worked example does not cover (verdict colitur, known limitation). test/test_golden_of.ml (new, 7 pins): a year Ordinary Time skips a week (2026) plus Mary Mother of the Church same date; Advent IV on Christmas Eve in two independent years (2028, 2034); the Annunciation transferred out of Holy Week to Easter+8 (2027, both ends of the transfer pinned); All Souls; the Sacred Heart; 17 December's date-keyed reading in two civil years/weekday-cycle letters. Every new layer mutation-proved: reverting the Advent-IV fix reddens two golden pins; corrupting Precedence_of.band's Tabula I.3 value reddens the litcal grade comparator across every Solemnity in the fixture; renaming one temporal slug reddens the litcal identity comparator; dropping Ordinary Time's second season_runs entry reddens both the landmark-years test and the sampled property. Each mutation applied to lib/rites/rite_of/, confirmed red, then reverted -- git diff --stat lib/ is empty. make check (COLITUR_EXHAUSTIVE_SWEEP=1 dune test --force): exit 0, 890 tests, 363.5s. EF byte-identity holds: git diff --stat v1.0.0..HEAD -- lib/rites/rite_ef/ lib/kernel/ data/ef/ is empty.
Diffstat (limited to 'test')
-rw-r--r--test/test_colitur.ml2
-rw-r--r--test/test_golden_of.ml332
-rw-r--r--test/test_litcal_of.ml553
-rw-r--r--test/test_validate_of.ml323
4 files changed, 1194 insertions, 16 deletions
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index 4b7c78a..6c00ee4 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -14,6 +14,7 @@ let () =
Test_overlay.suite; Test_overlay_ini.suite; Test_temporal_ef.suite; Test_temporal_of.suite; Test_litcal_of.suite; Test_precedence_of.suite;
Test_amendments_of.suite;
Test_validate.suite;
+ Test_validate_of.suite;
Test_precedence.suite;
Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_calendar_of_data.suite;
Test_rite_ef.suite;
@@ -26,6 +27,7 @@ let () =
Test_efdotorg_ordo.suite_2024_2025; Test_efdotorg_ordo.suite_2025_2026; Test_efdotorg_ordo.suite_2026_2027;
Test_efdotorg_ordo.suite_allow_list;
Test_golden.suite;
+ Test_golden_of.suite;
("lectionary", Test_lectionary.suite);
("lectionary-ef", Test_lectionary_ef.suite);
("lectionary-of", Test_lectionary_of.suite);
diff --git a/test/test_golden_of.ml b/test/test_golden_of.ml
new file mode 100644
index 0000000..f40b62a
--- /dev/null
+++ b/test/test_golden_of.ml
@@ -0,0 +1,332 @@
+(* Task 6 (2026-08-26-colitur-of-phases-3-5): golden pins, the OF
+ counterpart of test_golden.ml -- validation layer 5, one rite down.
+
+ *** THE ONE RULE THIS FILE IS BUILT AROUND (test_golden.ml's own,
+ restated for this file) ***
+
+ A golden test blesses whatever it is given. Every other layer this
+ branch built derives its expectation from something independent of
+ colitur's own output -- a property (test_validate_of.ml), a second
+ implementation (test_litcal_of.ml). This layer's expectation comes from
+ ME, so every literal string below was checked BY HAND, against the
+ primary-source citations already carried by temporal_of.ml/
+ precedence_of.ml/the amendment files (each pin's own comment names
+ which), BEFORE it was typed in here -- never copied from a `colitur
+ day`/`readings` run and then rationalised. Every date and weekday
+ claim below was independently cross-checked against
+ {!Colitur_kernel.Computus.gregorian_easter} arithmetic done BY HAND
+ (Easter date + a day-offset, or a `date -d` cross-check for a fixed
+ date), the same discipline test_golden.ml's own header states for its
+ own pins.
+
+ Six landmark/tricky dates, per this task's own brief, at minimum:
+ 1. A year Ordinary Time skips a week (2026 -- already independently
+ hand-verified, twice over, by test_temporal_of.ml's own
+ [test_ordinary_time_resumption]; reused here, not re-derived, since
+ re-deriving the SAME arithmetic a second time would not add
+ confidence, only a second literal to keep in sync).
+ 2. A year 24 December falls on a Sunday (2028; the Advent IV case --
+ commit a2fba71d, "fix(of): Nativity Vigil no longer suppresses a
+ Sunday of Advent").
+ 3. A year the Annunciation falls in Holy Week (2027; Normae n. 60's
+ fixed Easter+8 transfer).
+ 4. Mary, Mother of the Church (Easter+50).
+ 5. All Souls (2 November).
+ 6. The Sacred Heart (Easter+68).
+ Plus 17 December's own date-keyed reading (Gen 49:2,8-10 / Mt 1:1-17,
+ fixed earlier on this branch, commit b6d0eba0). *)
+
+module Cal = Colitur_kernel.Calendar
+module Layer = Colitur_kernel.Layer
+module Overlay = Colitur_kernel.Overlay
+module LD = Colitur_kernel.Liturgical_day
+module Slug = Colitur_kernel.Slug
+module Date = Colitur_kernel.Date
+module Cel = Colitur_kernel.Celebration
+module Colour = Colitur_kernel.Colour
+module Citation = Colitur_kernel.Citation
+module Temporal = Colitur_kernel.Temporal
+module Subject = Colitur_kernel.Subject
+module V = Rite_of.Vocab_of
+
+let calendar_path = "../data/of/calendar-2002.sexp"
+let amendments_dir = "../data/of/amendments/"
+let of_lectionary_path = "../data/of/lectionary.sexp"
+
+let amendment_files =
+ [ "001-padre-pio.sexp"; "002-juan-diego-cuauhtlatoatzin.sexp"; "003-our-lady-of-guadalupe.sexp";
+ "004-john-xxiii-john-paul-ii.sexp"; "005-mary-magdalene-rank.sexp"; "006-mary-mother-of-the-church.sexp";
+ "007-paul-vi.sexp"; "008-our-lady-of-loreto.sexp"; "009-faustina-kowalska.sexp";
+ "010-narek-avila-hildegard.sexp"; "011-martha-mary-lazarus.sexp"; "012-teresa-of-calcutta.sexp";
+ "013-john-henry-newman.sexp" ]
+
+(* Duplicated verbatim from test_rite_of.ml/test_validate_of.ml -- see
+ either file's own header for why (no .mli any of them could share it
+ through). *)
+let real_of_layer =
+ let base =
+ match Layer.load V.rank_of_sexp calendar_path with
+ | Ok l -> l
+ | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" calendar_path e)
+ in
+ let overlays =
+ List.map
+ (fun name ->
+ let path = amendments_dir ^ name in
+ match Overlay.load V.rank_of_sexp path with
+ | Ok o -> o
+ | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" path e))
+ amendment_files
+ in
+ let layer, diagnostics = Overlay.merge base overlays in
+ if diagnostics <> [] then
+ failwith
+ (Printf.sprintf "unexpected amendment diagnostics: %s"
+ (String.concat "; " (List.map Overlay.diagnostic_to_string diagnostics)));
+ layer
+
+let real_of_lectionary =
+ match Colitur_kernel.Lectionary.load of_lectionary_path with
+ | Ok l -> l
+ | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" of_lectionary_path e)
+
+let real_of_rite = Rite_of.context ~lectionary:real_of_lectionary
+
+let mk y m d = match Date.make ~year:y ~month:m ~day:d with Ok t -> t | Error e -> failwith e
+let fetch y m d = Cal.day real_of_rite real_of_layer (mk y m d)
+
+let slug_s (c : V.rank Cel.t) = Slug.to_string c.Cel.slug
+let rank_s (c : V.rank Cel.t) = V.rank_to_string c.Cel.rank
+let colour_s (c : V.rank Cel.t) = Colour.to_string c.Cel.colour
+let subject_s (c : V.rank Cel.t) = Subject.to_string c.Cel.subject
+
+(* [describe]'s own five components mirror {!Colitur_kernel.Liturgical_day
+ .t}'s own promise never to lose a field, the same discipline
+ test_golden.ml's header argues for at length -- one string per day, not
+ five separate checks, so a one-line diff on failure still names the day
+ and shows exactly which field changed.
+
+ [comms] is included even though it is STRUCTURALLY ALWAYS "[]" for this
+ rite ({!Rite_of.Precedence_of.admit} never returns anything else,
+ Precedence_of.mli's own citation) -- kept in the format rather than
+ dropped, so a future rite-level change that somehow populated it would
+ still show up in every existing pin's own diff, not silently pass. *)
+let describe (day : (V.season, V.rank) LD.t) =
+ let t = day.LD.temporal in
+ let week = match t.Temporal.week with Some n -> string_of_int n | None -> "-" in
+ let comms =
+ List.map (fun (c, _) -> slug_s c) day.LD.commemorations |> List.sort compare |> String.concat ","
+ in
+ let tin = match day.LD.transferred_in with None -> "-" | Some c -> slug_s c in
+ let tout =
+ List.map (fun (c, d) -> Printf.sprintf "%s->%s" (slug_s c) (Date.to_iso8601 d)) day.LD.transferred_out
+ |> List.sort compare |> String.concat ","
+ in
+ Printf.sprintf "%s %s season=%s week=%s slug=%s rank=%s colour=%s subject=%s comms=[%s] in=%s out=[%s]"
+ (Date.to_iso8601 day.LD.date)
+ (Date.weekday_to_string t.Temporal.weekday)
+ (V.season_to_string t.Temporal.season)
+ week (slug_s day.LD.observed) (rank_s day.LD.observed) (colour_s day.LD.observed) (subject_s day.LD.observed)
+ comms tin tout
+
+let check ~msg y m d expected = Alcotest.(check string) msg expected (describe (fetch y m d))
+
+let describe_readings (day : (V.season, V.rank) LD.t) =
+ let part_ref p =
+ match List.find_opt (fun (c : Citation.t) -> c.Citation.part = p) day.LD.citations with
+ | Some c -> c.Citation.reference
+ | None -> "-"
+ in
+ Printf.sprintf "%s slug=%s first=%s gospel=%s"
+ (Date.to_iso8601 day.LD.date)
+ (slug_s day.LD.observed) (part_ref Citation.First) (part_ref Citation.Gospel)
+
+let check_readings ~msg y m d expected = Alcotest.(check string) msg expected (describe_readings (fetch y m d))
+
+(* ------------------------------------------------------------------ *)
+(* 1. Ordinary Time skips a week: 2026. Pentecost is 24 May 2026 (Easter *)
+(* 5 April + 49); block A tops out at week 6 (Shrove Tuesday, 17 Feb, *)
+(* independently hand-verified against Ash Wednesday 18 Feb); Normae *)
+(* n. 43-44's own two-block arithmetic resumes the Monday after Pentecost *)
+(* (25 May) at week 8, not 7 -- week 7 never occurs anywhere in Ordinary *)
+(* Time that civil year (test_temporal_of.ml's own *)
+(* [test_ordinary_time_resumption], which checks this exhaustively over *)
+(* the WHOLE civil year, not merely this one pinned Monday). Pinned here *)
+(* through the ASSEMBLED pipeline (Rite_of.context/Calendar.day), not *)
+(* Temporal_of directly -- the same "genuinely different code path" *)
+(* argument test_validate_of.ml's own [ot_and_coverage_of_year] makes. *)
+(* ------------------------------------------------------------------ *)
+
+let test_ordinary_time_skips_a_week_2026 () =
+ (* subject=temporal, not =lord: {!Rite_of.Temporal_of.named}'s own tuple
+ shape (season, slug, colour, rank) carries no subject field at all,
+ so every day it builds (Nativity, Epiphany, Ascension, Pentecost, Ash
+ Wednesday, Palm Sunday, Easter, the Easter Octave, Trinity, Corpus
+ Christi, Christ the King) defaults to {!Colitur_kernel.Subject
+ .Temporal} -- {!Rite_of.Precedence_of.band}'s own entry-2 branch
+ routes these by SLUG membership ([entry_2_named]), never by subject,
+ so this is not a gap, just a different (and correct) tagging
+ convention from the DATA-origin solemnities pinned elsewhere in this
+ file (Sacred Heart, the Annunciation, All Souls), which carry a real
+ [subject] field in their own calendar-2002.sexp/amendment record. *)
+ check ~msg:"2026-05-24 Pentecost: Easter+49, red, block A's own last Sunday" 2026 5 24
+ "2026-05-24 sunday season=easter week=8 slug=of-pentecost rank=sollemnitas colour=red subject=temporal \
+ comms=[] in=- out=[]";
+ check ~msg:"2026-05-25 (Mon after Pentecost) resumes Ordinary Time at week 8, SKIPPING week 7" 2026 5 25
+ "2026-05-25 monday season=ordinary-time week=8 slug=mary-mother-of-the-church rank=memoria-obligatoria \
+ colour=white subject=bvm comms=[] in=- out=[]"
+
+(* ------------------------------------------------------------------ *)
+(* 2. 24 December falls on a Sunday: 2028 (and, symmetrically, 2034 -- *)
+(* both inside commit a2fba71d's own worked examples). Before that fix, *)
+(* the Vigil Mass of the Nativity silently displaced the Fourth Sunday of *)
+(* Advent (Tabula I.2/Normae n. 5 -- a privileged Sunday outranks *)
+(* everything but a HIGHER Tabula entry, and the Vigil is Tabula I.3). *)
+(* After it, 24 December on a Sunday resolves as the Fourth Sunday of *)
+(* Advent itself, violet (Advent's own colour, not Gaudete's rose -- *)
+(* that is week 3 only, IGMR 346(c)/[V.season]'s own [is_rose_sunday]). *)
+(* ------------------------------------------------------------------ *)
+
+let test_advent_iv_on_christmas_eve_2028 () =
+ check ~msg:"2028-12-24 (a Sunday): the Fourth Sunday of Advent, not the Vigil (Tabula I.2 over I.3)" 2028 12 24
+ "2028-12-24 sunday season=advent week=4 slug=of-advent-sunday-4 rank=sollemnitas colour=violet \
+ subject=temporal comms=[] in=- out=[]";
+ (* The day immediately before it: still the Third Week of Advent, an
+ ordinary (non-rose) Saturday feria -- confirms the season/week
+ boundary itself sits in the right place, not merely that 24 December
+ alone reads correctly. *)
+ check ~msg:"2028-12-23: still Advent week 3, an ordinary violet feria" 2028 12 23
+ "2028-12-23 saturday season=advent week=3 slug=of-advent-3-saturday rank=feria colour=violet subject=temporal \
+ comms=[] in=- out=[]";
+ (* And the day after: Christmas Day itself, entirely unaffected by which
+ office 24 December carried. *)
+ check ~msg:"2028-12-25: the Nativity, unaffected" 2028 12 25
+ "2028-12-25 monday season=christmas week=- slug=of-nativity rank=sollemnitas colour=white subject=temporal \
+ comms=[] in=- out=[]"
+
+(* The symmetric 2034 witness -- a second, independent year, not a
+ re-check of the same arithmetic (a fix that happened to work for one
+ specific weekday alignment but not the general rule would show up as a
+ difference here). *)
+let test_advent_iv_on_christmas_eve_2034 () =
+ check ~msg:"2034-12-24 (a Sunday): the Fourth Sunday of Advent" 2034 12 24
+ "2034-12-24 sunday season=advent week=4 slug=of-advent-sunday-4 rank=sollemnitas colour=violet \
+ subject=temporal comms=[] in=- out=[]"
+
+(* ------------------------------------------------------------------ *)
+(* 3. The Annunciation in Holy Week: 2027 (Easter 28 March 2027, so 25 *)
+(* March is Easter-3, the Thursday of Holy Week). Normae n. 60's own *)
+(* FIRST, fixed-destination rule (not the general "nearest later free *)
+(* day" search rule 3): "Sollemnitas... Annuntiationis Domini, *)
+(* quotiescumque occurrit aliquo die Hebdomadae sanctae, semper ad feriam *)
+(* II post dominicam II Paschae erit transferenda" -- ALWAYS to the *)
+(* Monday after the Second Sunday of Easter, Easter+8, here 5 April 2027. *)
+(* Pinned as THREE dates, not one: 25 March itself (Holy Thursday's own *)
+(* office wins outright, IGMR 346(a)'s "celebrationibus Domini, quae non *)
+(* sint de eius Passione" -- white, not Passiontide violet/red), the *)
+(* departure recorded in [out], and the arrival on 5 April recorded in *)
+(* [in] -- Calendar's own transfer bookkeeping, both ends. *)
+(* ------------------------------------------------------------------ *)
+
+let test_annunciation_holy_week_2027 () =
+ check ~msg:"2027-03-25 (Holy Thursday, Easter-3): the day's own office wins, white, and records the \
+ Annunciation's own departure"
+ 2027 3 25
+ "2027-03-25 thursday season=lent week=6 slug=of-lent-6-thursday rank=feria colour=white subject=temporal \
+ comms=[] in=- out=[annunciation-of-the-lord->2027-04-05]";
+ check ~msg:"2027-04-05 (Easter+8, the Monday after the Second Sunday of Easter): the Annunciation arrives" 2027 4
+ 5
+ "2027-04-05 monday season=easter week=2 slug=annunciation-of-the-lord rank=sollemnitas colour=white \
+ subject=lord comms=[] in=annunciation-of-the-lord out=[]"
+
+(* ------------------------------------------------------------------ *)
+(* 4. Mary, Mother of the Church: Easter+50, the Monday after Pentecost *)
+(* (data/of/amendments/006-mary-mother-of-the-church.sexp's own citation, *)
+(* CDW decree 11 February 2018, Prot. N. 1037/2017, AAS 110 (2018) *)
+(* 437-438). ALREADY the day this file's own [test_ordinary_time_skips_a_ *)
+(* week_2026] pins (2026-05-25) -- not re-pinned a second time under a *)
+(* different date; that pin's own [msg] is worded to name both facts it *)
+(* carries (the week-8 resumption AND Mother of the Church herself), the *)
+(* SAME "one string, several independently-true facts" economy *)
+(* test_golden.ml's own header argues for, rather than a second literal *)
+(* asserting the identical field values under a different label. *)
+(* ------------------------------------------------------------------ *)
+
+(* ------------------------------------------------------------------ *)
+(* 5. All Souls: 2 November, every year, unconditionally (a fixed date, *)
+(* not movable) -- Tabula I.3 ("Commemoratio omnium fidelium *)
+(* defunctorum"), tagged Sollemnitas on the Tabula's own authority *)
+(* despite the calendarium page itself printing no grade word *)
+(* (precedence_of.ml's own [band] entry-3 citation has the full *)
+(* argument). Violet (not white, not black) -- shipped *)
+(* data/of/calendar-2002.sexp's own colour, already independently *)
+(* exercised by test_precedence_of.ml's own *)
+(* [test_all_souls_beats_an_ordinary_sunday] against a DIFFERENT year *)
+(* (2025-11-02, itself a Sunday); 2026 is chosen here instead so this *)
+(* file's own pin is not a byte-identical duplicate of that one. ------- *)
+
+let test_all_souls_2026 () =
+ check ~msg:"2026-11-02: All Souls, violet, every year unconditionally" 2026 11 2
+ "2026-11-02 monday season=ordinary-time week=31 slug=all-souls rank=sollemnitas colour=violet subject=saint \
+ comms=[] in=- out=[]"
+
+(* ------------------------------------------------------------------ *)
+(* 6. The Sacred Heart: Easter+68 (calendar-2002.sexp's own *)
+(* [Easter_offset 68] entry) -- Easter 2026 is 5 April, so Easter+68 is *)
+(* 12 June 2026 (25 days left in April + 31 in May + 12 = 68, hand- *)
+(* verified against {!Colitur_kernel.Computus.gregorian_easter} directly, *)
+(* not merely trusted from the offset). White, Sollemnitas, subject Lord *)
+(* -- shipped data, matching the Missal's own title ("SACRATISSIMI *)
+(* CORDIS IESU"). ------------------------------------------------------ *)
+
+let test_sacred_heart_2026 () =
+ Alcotest.(check string) "Easter 2026 is really 5 April (the Sacred Heart's own Easter+68 anchor)" "2026-04-05"
+ (Date.to_iso8601 (Colitur_kernel.Computus.gregorian_easter 2026));
+ check ~msg:"2026-06-12 (Easter+68): the Sacred Heart of Jesus" 2026 6 12
+ "2026-06-12 friday season=ordinary-time week=10 slug=sacred-heart-of-jesus rank=sollemnitas colour=white \
+ subject=lord comms=[] in=- out=[]"
+
+(* ------------------------------------------------------------------ *)
+(* 7. 17 December's own date-keyed reading (OLM n. 69.3, commit b6d0eba0, *)
+(* "fix(of-lectionary): stop serving drifting readings for O-Antiphon and *)
+(* Christmas-season dates"): Genesis 49:2,8-10 / Matthew 1:1-17, fixed by *)
+(* CIVIL DATE, not by the day's own weekday-keyed ferial slug -- this pin *)
+(* is what would have caught the original bug (a citation that silently *)
+(* drifted year to year on this date before the fix), pinned through the *)
+(* full resolved pipeline rather than test_lectionary_of.ml's own more *)
+(* narrowly-scoped unit test for the same fact. Raw reference strings *)
+(* (data/of/lectionary.sexp's own literal text, "Genesis"/"Matthew" in *)
+(* full), not a rendered siglum -- the same discipline test_golden.ml's *)
+(* own [describe_readings] follows for EF. *)
+(* ------------------------------------------------------------------ *)
+
+let test_december_17_reading () =
+ check_readings ~msg:"2026-12-17: the O-Antiphon date-keyed reading, Genesis 49:2,8-10 / Matthew 1:1-17" 2026 12
+ 17 "2026-12-17 slug=of-advent-3-thursday first=Genesis 49:2,8-10 gospel=Matthew 1:1-17";
+ (* A second, independent civil year -- OLM n. 69.4's weekday-cycle
+ letter flips on the liturgical year's own parity (Lectionary_of
+ .weekday_cycle), so a date-keyed reading that accidentally still
+ routed through the weekday-keyed path would likely only fail in
+ roughly half of all years -- this second year is chosen from the
+ OTHER cycle letter than 2026's own (test_lectionary_of.ml's own
+ [test_date_keyed_no_drift] already proves this pair directly at the
+ Lectionary_of level; repeated here through the full pipeline for the
+ same reason [test_advent_iv_on_christmas_eve_2034] repeats 2028's own
+ shape in a second year). *)
+ check_readings ~msg:"2027-12-17: the same date-keyed reading, a second civil year, the other weekday-cycle \
+ letter"
+ 2027 12 17 "2027-12-17 slug=of-advent-3-friday first=Genesis 49:2,8-10 gospel=Matthew 1:1-17"
+
+let suite =
+ ( "golden-of",
+ [ Alcotest.test_case "Ordinary Time skips a week (2026); Mary, Mother of the Church" `Quick
+ test_ordinary_time_skips_a_week_2026;
+ Alcotest.test_case "Advent IV on Christmas Eve (2028)" `Quick test_advent_iv_on_christmas_eve_2028;
+ Alcotest.test_case "Advent IV on Christmas Eve, a second year (2034)" `Quick
+ test_advent_iv_on_christmas_eve_2034;
+ Alcotest.test_case "the Annunciation in Holy Week, transferred to Easter+8 (2027)" `Quick
+ test_annunciation_holy_week_2027;
+ Alcotest.test_case "All Souls (2026)" `Quick test_all_souls_2026;
+ Alcotest.test_case "the Sacred Heart, Easter+68 (2026)" `Quick test_sacred_heart_2026;
+ Alcotest.test_case "17 December's own date-keyed reading, two civil years" `Quick test_december_17_reading
+ ] )
diff --git a/test/test_litcal_of.ml b/test/test_litcal_of.ml
index 1144859..0c53899 100644
--- a/test/test_litcal_of.ml
+++ b/test/test_litcal_of.ml
@@ -12,22 +12,53 @@
SECOND-IMPLEMENTATION-NOT-SECOND-PUBLICATION caveat this layer is
built under -- NOT repeated here.
- `rite_of` is deliberately not wired into `Colitur_kernel.Rite.t` or the
- CLI yet (Phase 2's own work) -- this file calls
- {!Rite_of.Temporal_of.temporal} directly, exactly as test_temporal_of.ml
- already does, over the SAME civil-date window the fixture covers
- (2023-12-03..2035-12-01), no {!Colitur_kernel.Calendar}/{!Colitur_kernel
- .Layer} involved.
+ The season/week half below (unchanged since 2026-08-25) calls
+ {!Rite_of.Temporal_of.temporal} directly, over the SAME civil-date
+ window the fixture covers (2023-12-03..2035-12-01), no
+ {!Colitur_kernel.Calendar}/{!Colitur_kernel.Layer} involved -- Phase 2
+ had not wired {!Colitur_kernel.Rite.t} yet when it was written.
- SCOPE: season and Ordinary Time week only -- the two fields the fixture
- carries. Rank/colour/named-day identity are out of scope for this
- layer (Phase 1 has no sanctoral data to compare them against, and
- litcal's own [grade_lcl]/[name] are read here only to CLASSIFY why a
- week is unwitnessed, never compared against a colitur rank). *)
+ ---------------------------------------------------------------------
+ TASK 6 EXTENSION (2026-08-26-colitur-of-phases-3-5, task 6): GRADE and
+ IDENTITY. Phase 2/Task 5 have since assembled the real {!Rite_of.context}
+ and a full shipped calendar, so this file now ALSO resolves every
+ fixture date through {!Colitur_kernel.Calendar} (real
+ data/of/calendar-2002.sexp + all 13 amendment overlays + the real
+ lectionary, exactly {!Rite_of.context} as `colitur day --rite of`
+ assembles it) and compares:
+
+ - GRADE: litcal's own [grade_lcl] bucketed against the Tabula entry
+ {!Rite_of.Precedence_of.band} assigns the day's OWN observed
+ celebration (reconstructed as a candidate exactly the way
+ {!Colitur_kernel.Validate.run}'s own "admission" check already
+ does -- see [band_of] below). Covers every row EXCEPT three
+ structurally uninformative classes, each named and counted, never
+ silently skipped -- see [expected_bands]'s own comment.
+ - IDENTITY: colitur's own observed [slug] against a HAND-VERIFIED
+ [event_key -> slug] table (every entry checked against
+ data/of/calendar-2002.sexp or temporal_of.ml directly before being
+ typed in -- the same "checked before being typed in" discipline
+ test_golden.ml's own header states for its pins), scoped
+ DELIBERATELY NARROWER than grade -- see [identity_map]'s own
+ comment for exactly what is and is not attempted and why.
+
+ Both follow the SAME counted-and-allow-listed discipline L1 already
+ established for season: a divergence not covered by an allow-list
+ entry fails the suite outright ("zero unexplained"); a row this layer
+ cannot meaningfully compare is counted under its own name, never
+ silently dropped -- the EF oracle layer's own [Comm_identity_unresolved]
+ precedent (CLAUDE.md's "know what each layer cannot see" section). *)
module V = Rite_of.Vocab_of
module T = Rite_of.Temporal_of
module D = Colitur_kernel.Date
+module Layer = Colitur_kernel.Layer
+module Overlay = Colitur_kernel.Overlay
+module Cal = Colitur_kernel.Calendar
+module LD = Colitur_kernel.Liturgical_day
+module Slug = Colitur_kernel.Slug
+module Cel = Colitur_kernel.Celebration
+module Prec = Colitur_kernel.Precedence
let fixture_path = "fixtures/litcal-temporal-2024-2035.sexp"
let allow_list_path = "../data/of/expected-divergences-litcal.sexp"
@@ -139,6 +170,227 @@ let load_allow_list () =
let is_l1_triduum (r : litcal_row) = String.equal r.season "easter_triduum"
(* ---------------------------------------------------------------------- *)
+(* Task 6: the real, resolved OF calendar -- the same assembly bin/main.ml's *)
+(* [load_of_layer]/[resolved_of_year_days] and test_rite_of.ml's own *)
+(* [real_of_layer]/[real_of_rite] perform. Duplicated rather than shared, *)
+(* the same discipline every Ordo/oracle test file in this project already *)
+(* states for itself (this file's own [sha256_of_file] comment, above): no *)
+(* .mli any of them could share it through. *)
+(* ---------------------------------------------------------------------- *)
+
+let calendar_path = "../data/of/calendar-2002.sexp"
+let amendments_dir = "../data/of/amendments/"
+let of_lectionary_path = "../data/of/lectionary.sexp"
+
+let amendment_files =
+ [ "001-padre-pio.sexp"; "002-juan-diego-cuauhtlatoatzin.sexp"; "003-our-lady-of-guadalupe.sexp";
+ "004-john-xxiii-john-paul-ii.sexp"; "005-mary-magdalene-rank.sexp"; "006-mary-mother-of-the-church.sexp";
+ "007-paul-vi.sexp"; "008-our-lady-of-loreto.sexp"; "009-faustina-kowalska.sexp";
+ "010-narek-avila-hildegard.sexp"; "011-martha-mary-lazarus.sexp"; "012-teresa-of-calcutta.sexp";
+ "013-john-henry-newman.sexp" ]
+
+let real_of_layer =
+ let base =
+ match Layer.load V.rank_of_sexp calendar_path with
+ | Ok l -> l
+ | Error e -> Alcotest.failf "%s: failed to load: %s" calendar_path e
+ in
+ let overlays =
+ List.map
+ (fun name ->
+ let path = amendments_dir ^ name in
+ match Overlay.load V.rank_of_sexp path with
+ | Ok o -> o
+ | Error e -> Alcotest.failf "%s: failed to load: %s" path e)
+ amendment_files
+ in
+ let layer, diagnostics = Overlay.merge base overlays in
+ if diagnostics <> [] then
+ Alcotest.failf "unexpected amendment diagnostics: %s"
+ (String.concat "; " (List.map Overlay.diagnostic_to_string diagnostics));
+ layer
+
+let real_of_lectionary =
+ match Colitur_kernel.Lectionary.load of_lectionary_path with
+ | Ok l -> l
+ | Error e -> Alcotest.failf "%s: failed to load: %s" of_lectionary_path e
+
+let real_of_rite = Rite_of.context ~lectionary:real_of_lectionary
+
+(* Every fixture date resolved once, indexed by rata die -- civil years
+ 2022..2036 comfortably bracket the fixture's own 2023-12-03..2035-12-01
+ span with slack at both edges ({!Colitur_kernel.Calendar.year}'s own [y]
+ covers Advent of civil year [y] through the following November, so [y]
+ itself does not line up with the fixture's own civil-date window without
+ this margin). Built once at module init, same reasoning test_validate.ml's
+ own [real_ef_layer] gives: every test below reads it, and resolving 15
+ liturgical years once is far cheaper than resolving one per lookup. *)
+let resolved_index =
+ let tbl : (int, (V.season, V.rank) LD.t) Hashtbl.t = Hashtbl.create 5000 in
+ for y = 2022 to 2036 do
+ Array.iter
+ (fun (d : (V.season, V.rank) LD.t) -> Hashtbl.replace tbl (D.to_rata d.LD.date) d)
+ (Cal.year real_of_rite real_of_layer y)
+ done;
+ tbl
+
+let resolved_of iso =
+ let d = match D.of_iso8601 iso with Ok d -> d | Error e -> Alcotest.failf "%s: %s" iso e in
+ match Hashtbl.find_opt resolved_index (D.to_rata d) with
+ | Some day -> day
+ | None -> Alcotest.failf "%s: not resolved -- outside [resolved_index]'s own civil-year margin" iso
+
+(* [band_of]: the Tabula entry (x10) colitur's OWN band function assigns the
+ day's observed celebration -- NOT re-derived from [rank]/[subject] by hand
+ here (that would silently drift from precedence_of.ml's own table the
+ moment a branch there changed), but computed by calling
+ {!Rite_of.Precedence_of.band} itself, exactly the way
+ {!Colitur_kernel.Validate.run}'s own "admission" check reconstructs a
+ candidate from a resolved {!Colitur_kernel.Liturgical_day.t} (that
+ function's own comment is the citation for the origin-recovery technique
+ reused here): a commemoration whose slug matches the day's own temporal
+ office is temporal-origin, everything else is sanctoral-origin -- exact
+ whenever slugs cannot collide across the two streams, the same assumption
+ the rest of this codebase already leans on. *)
+let band_of (day : (V.season, V.rank) LD.t) =
+ let t = day.LD.temporal in
+ let temporal_slug = t.Colitur_kernel.Temporal.office.Cel.slug in
+ let observed = day.LD.observed in
+ let origin = if Slug.equal observed.Cel.slug temporal_slug then Prec.Temporal else Prec.Sanctoral in
+ let cand : V.rank Prec.candidate = { Prec.cel = observed; origin } in
+ let ctx : V.season Prec.context =
+ { Prec.date = day.LD.date; season = t.Colitur_kernel.Temporal.season; weekday = t.Colitur_kernel.Temporal.weekday }
+ in
+ Rite_of.Precedence_of.band ctx cand
+
+(* litcal's own [grade_lcl] text, bucketed to the set of Tabula band values
+ ({!Rite_of.Precedence_of.band}'s own x10 scale) that grade can legitimately
+ correspond to on colitur's side -- verified against precedence_of.ml's own
+ band branches, not guessed from the grade word alone:
+
+ - "SOLEMNITY" -> Tabula I.3/I.4 (30/40)
+ - "celebration with precedence over solemnities"
+ (litcal's own text for Tabula I.1/I.2: the Triduum, the Nativity,
+ Epiphany, Ascension, Pentecost, Ash Wednesday, the privileged Sundays
+ of Advent/Lent/Easter, the Holy Week ferias, the Easter Octave)
+ -> Tabula I.1/I.2 (10/20)
+ - "FEAST OF THE LORD" (a Feast of the Lord, Tabula II.5, AND an ordinary
+ Sunday of Christmas/Ordinary Time, Tabula II.6 -- litcal's own grade
+ text does not distinguish the two; neither does this bucket)
+ -> Tabula II.5/II.6 (50/60)
+ - "FEAST" -> Tabula II.7/II.8 (70/80)
+ - "Memorial" -> Tabula III.10/III.11 (100/110)
+
+ THREE classes are DELIBERATELY [None] here -- not silently dropped, see
+ [test_grade_unresolved_is_counted] below for why each is uninformative
+ rather than merely unbuilt:
+
+ - "weekday": litcal's own [pick_representative] (the fixture generator,
+ tools/extract_litcal_ordo.py) ALWAYS prefers an Ord*/AdventWeekday/
+ LentWeekday/etc. row over a CO-LISTED optional memorial on the same
+ date (its own docstring, "prefers the Ord* row; else the lowest-
+ event_idx row that is not an 'optional memorial'"). colitur's own
+ Precedence_of.band gives an optional memorial (Tabula III.12, band 120)
+ a LOWER band than an ordinary feria (Tabula III.13, band 130) -- lower
+ wins -- so on any date litcal tags "weekday" that ALSO happens to carry
+ an unlisted optional memorial, colitur legitimately elects that
+ memorial as its own observed day (Task 6 brief's self-review: "this
+ plan models an unelected optional memorial as an ordinary loser
+ (Omit)" -- the COMPLEMENT, an ELECTED one, becomes the day's own
+ [observed]). Whether that unlisted memorial exists on any given
+ "weekday" date is exactly the information [pick_representative]
+ discards, so a "weekday" row's own grade is uninformative for this
+ comparison, not merely inconvenient -- comparing it would manufacture
+ spurious mismatches out of a fixture-generation choice, not a real
+ divergence.
+ - "optional memorial": the 5 rows [pick_representative]'s own third,
+ rarer shape produces (two co-listed optional memorials, no weekday row
+ at all, all five in the Immaculate-Heart-of-Mary window -- this file's
+ own header/the generator's own comment) -- which of the two litcal's
+ picker names is itself acknowledged upstream as arbitrary (lowest
+ [event_idx]), so it carries no comparable claim about which one, if
+ either, colitur elects.
+ - Triduum rows are excluded a level up, by the caller, via
+ [is_l1_triduum] -- see [test_grade_matches_or_is_explained]'s own
+ comment for why this reuses L1's own reasoning rather than duplicating
+ it. *)
+let expected_bands = function
+ | "SOLEMNITY" -> Some [ 30; 40 ]
+ | "celebration with precedence over solemnities" -> Some [ 10; 20 ]
+ | "FEAST OF THE LORD" -> Some [ 50; 60 ]
+ | "FEAST" -> Some [ 70; 80 ]
+ | "Memorial" -> Some [ 100; 110 ]
+ | "weekday" | "optional memorial" -> None
+ | g -> Alcotest.failf "unrecognised litcal grade_lcl: %S" g
+
+(* [identity_map]: [event_key -> colitur slug], HAND-VERIFIED against
+ data/of/calendar-2002.sexp (`grep -n "((slug " data/of/calendar-2002.sexp`,
+ one date/slug pair confirmed per entry before it was typed in below) or
+ lib/rites/rite_of/temporal_of.ml directly for the CODE-computed entries
+ (the Sundays/named movable days), never copied from a `colitur day` run
+ -- test_golden.ml's own header states the identical discipline for its
+ pins, and it is followed here for the same reason.
+
+ DELIBERATELY NARROWER than [expected_bands]'s own grade coverage, and
+ this is a real, stated scope limit, not an oversight: every event_key
+ mapped below is a FIXED, uniquely-named entity (a solemnity, a Feast of
+ the Lord, a universal Feast of an apostle/evangelist, or a fixed/movable
+ NAMED day -- Ascension, Ash Wednesday, the Nativity, Corpus Christi,
+ Easter Sunday itself, Epiphany, Palm Sunday, Pentecost, Trinity Sunday).
+ The NUMBERED series litcal's own event_keys also carry --
+ Advent1..Advent4, Lent1..Lent5, Easter2..Easter7, every OrdSundayN, and
+ the Holy Week/Easter Octave weekday events (MonHolyWeek, TueOctaveEaster,
+ etc.) -- are NOT individually mapped here. Building and hand-verifying a
+ slug for each of those would mean re-deriving colitur's own week-numbered
+ slug PATTERN (["of-%s-sunday-%d"]/["of-%s-%d-%s"], temporal_of.ml) by
+ hand for every one of ~185 rows, which is exactly the arithmetic Step 1's
+ own dedicated Ordinary-Time-week-bounds property and [Validate]'s own
+ ["week"] check already verify structurally, at far lower risk of a
+ transcription error than a hand-built parallel slug table would carry.
+ Left [None] here -- counted under [test_identity_unresolved_is_counted]
+ below as "patterned/numbered series, not individually name-mapped", a
+ real, deliberate, counted scope limit, not a silent gap -- the same
+ discipline the EF oracle layer's own [Comm_identity_unresolved] follows,
+ scoped narrower here (to the closed FIXED/NAMED set) rather than to a
+ SANCTORAL-origin/TEMPORAL-origin split, since here it is the fixture's
+ own vocabulary (a compact internal key, not a title) rather than the
+ celebration's origin that limits what a mapping can safely attempt. *)
+let identity_map =
+ [ (* Tabula I.3, universal solemnities. *)
+ ("AllSaints", "all-saints"); ("AllSouls", "all-souls"); ("Annunciation", "annunciation-of-the-lord");
+ ("Assumption", "assumption-of-the-blessed-virgin-mary"); ("ChristKing", "of-christ-the-king");
+ ("ImmaculateConception", "immaculate-conception-of-the-blessed-virgin-mary");
+ ("MaryMotherOfGod", "of-mary-mother-of-god"); ("NativityJohnBaptist", "birth-of-saint-john-the-baptist");
+ ("SacredHeart", "sacred-heart-of-jesus"); ("StJoseph", "joseph-husband-of-the-blessed-virgin-mary");
+ ("StsPeterPaulAp", "saints-peter-and-paul-apostles");
+ (* Tabula I.2, fixed/named days (CODE, temporal_of.ml's own [named]). *)
+ ("Ascension", "of-ascension"); ("AshWednesday", "of-ash-wednesday"); ("Christmas", "of-nativity");
+ ("CorpusChristi", "of-corpus-christi"); ("Easter", "of-easter-sunday"); ("Epiphany", "of-epiphany");
+ ("PalmSun", "of-palm-sunday"); ("Pentecost", "of-pentecost"); ("Trinity", "of-trinity");
+ (* Tabula II.5, Feasts of the Lord. *)
+ ("BaptismLord", "of-baptism-of-the-lord"); ("Christmas2", "of-christmas-sunday-2");
+ ("DedicationLateran", "dedication-of-the-lateran-basilica"); ("ExaltationCross", "triumph-of-the-holy-cross");
+ ("HolyFamily", "of-holy-family"); ("Presentation", "presentation-of-the-lord");
+ ("Transfiguration", "transfiguration-of-the-lord");
+ (* Tabula II.7, universal Feasts (apostles, evangelists, and similar). *)
+ ("ChairStPeter", "chair-of-saint-peter-apostle"); ("ConversionStPaul", "the-conversion-of-saint-paul-apostle");
+ ("HolyInnocents", "holy-innocents-martyrs"); ("NativityVirginMary", "birth-of-the-blessed-virgin-mary");
+ ("StAndrewAp", "andrew-the-apostle"); ("StBartholomewAp", "bartholomew-the-apostle");
+ ("StJamesAp", "james-apostle"); ("StJohnEvangelist", "john-the-apostle-and-evangelist");
+ ("StLawrenceDeacon", "lawrence-deacon-and-martyr"); ("StLukeEvangelist", "luke-the-evangelist");
+ ("StMarkEvangelist", "mark-the-evangelist"); ("StMatthewEvangelist", "matthew-the-evangelist-apostle-evangelist");
+ ("StMatthiasAp", "matthias-the-apostle"); ("StSimonStJudeAp", "simon-and-saint-jude-apostles");
+ ("StStephenProtomartyr", "stephen-the-first-martyr"); ("StThomasAp", "thomas-the-apostle");
+ ("StsArchangels", "saints-michael-gabriel-and-raphael-archangels");
+ ("StsPhilipJames", "saints-philip-and-james-apostles"); ("Visitation", "visitation-of-the-blessed-virgin-mary")
+ ]
+
+let identity_tbl =
+ let tbl = Hashtbl.create 64 in
+ List.iter (fun (k, v) -> Hashtbl.replace tbl k v) identity_map;
+ tbl
+
+(* ---------------------------------------------------------------------- *)
(* Tests *)
(* ---------------------------------------------------------------------- *)
@@ -193,10 +445,14 @@ let test_season_matches_or_is_explained () =
(List.rev !unexplained);
(match List.assoc_opt "L1" by_id with
| None -> Alcotest.failf "allow-list entry L1 is used by the comparator but not declared in %s" allow_list_path
- | Some e -> Alcotest.(check int) "L1 (Easter Triduum, no colitur season value) expected_rows" e.expected_rows !l1_count);
- List.iter
- (fun e -> if not (String.equal e.id "L1") then Alcotest.failf "unknown allow-list entry %s (only L1 is used)" e.id)
- allow_list
+ | Some e -> Alcotest.(check int) "L1 (Easter Triduum, no colitur season value) expected_rows" e.expected_rows !l1_count)
+(* No more "only L1 is used" check here: task 6 adds two more comparators
+ (grade, identity) against this SAME allow-list file, each with their own
+ ids. [test_allow_list_has_no_orphan_entries], at the end of this file,
+ is the single place that now asserts the WHOLE file's own id set is
+ exactly the union every comparator recognises -- one place, not three
+ copies of a whole-file assertion that would only ever be right in one
+ of them at a time. *)
(* THE load-bearing test: the Ordinary Time week, on every day litcal
actually witnesses one (an Ord* event_key present on that date) --
@@ -258,11 +514,276 @@ let test_unwitnessed_ordinary_time_is_counted () =
let total = Hashtbl.fold (fun _ n acc -> n + acc) by_grade 0 in
Alcotest.(check int) "grade_lcl buckets sum to the same 859" 859 total
+(* ---------------------------------------------------------------------- *)
+(* Task 6: GRADE. Every non-Triduum row whose [grade_lcl] names an *)
+(* [expected_bands] bucket (i.e. every row except "weekday"/"optional *)
+(* memorial", see that function's own comment) is checked against *)
+(* {!band_of}'s own reconstruction of colitur's REAL, resolved observed *)
+(* day -- real data/of/calendar-2002.sexp + all 13 amendments, not a *)
+(* placeholder. *)
+(* ---------------------------------------------------------------------- *)
+
+(* Row-classifiers for the divergence classes found by actually RUNNING this
+ comparator against real data (never guessed in advance) -- one predicate
+ per allow-list id, shared between the grade and identity comparators
+ where a class shows up in both (L6/L7, L8/L9 are the identity/grade
+ halves of the SAME root cause, exactly as L2/L3 already are for Holy
+ Family). Each is named for, and restricted to, the EXACT row(s) found;
+ none is a loose pattern that could silently absorb an unrelated future
+ mismatch. *)
+
+(* L2/L3 -- Normae n. 35(a), the Holy Family fallback: KNOWN WRONG, pinned
+ (not fixed) by test_rite_of.ml's own
+ [test_holy_family_fallback_1583_known_wrong_ferial]/
+ [is_known_holy_family_fallback_gap]. 30 December 2033 is this fixture's
+ own live witness (2033: 25 December is a Sunday, so 26-31 December's own
+ window has no Sunday of its own and {!Rite_of.Temporal_of.temporal}
+ never reaches [holy_family]'s own fixed 30-December fallback branch).
+ litcal correctly names ["HolyFamily"]; colitur observes an ordinary
+ Nativity-octave feria (Tabula II.9, band 90) instead. *)
+let is_l2_l3_holy_family_2033 (l : litcal_row) = String.equal l.event_key "HolyFamily" && String.equal l.date "2033-12-30"
+
+(* L4 -- litcal's own [grade_lcl] "celebration with precedence over
+ solemnities" text covers Trinity Sunday and Corpus Christi too (24
+ rows, every one of the fixture's 12 years), which precedence_of.ml's own
+ Tabula I.2 transcription does NOT: "Nativitas Domini, Epiphania, Ascensio
+ et Pentecostes; dominicae Adventus, Quadragesimae et Paschae; feria IV
+ Cinerum; hebdomada sancta a feria II ad V" names neither -- both are
+ "Sollemnitates Domini" (Tabula I.3, band 30), the SAME entry
+ {!Rite_of.Precedence_of.band} gives ChristKing, a structurally identical
+ "Solemnity of the Lord anchored to a Sunday within Ordinary Time" --
+ and litcal ITSELF labels ChristKing "SOLEMNITY", not this text (checked
+ directly: ChristKing is one of this file's own [identity_map] entries
+ and produces no grade mismatch anywhere in the fixture). That asymmetry
+ is offered as corroborating evidence, not proof (this task did not
+ inspect litcal's own source to confirm WHY), that litcal's own grade
+ vocabulary is coarser/inconsistent here rather than a considered,
+ different Tabula reading -- verdict "colitur". *)
+let is_l4_trinity_corpus_christi (l : litcal_row) =
+ String.equal l.event_key "Trinity" || String.equal l.event_key "CorpusChristi"
+
+(* L5 -- litcal's own data is STALE: "StMaryMagdalene" grade_lcl reads
+ "Memorial" on every one of the 10 years this fixture witnesses her (22
+ July; 2 of the 12 years have no witness at all, an ordinary per-annum
+ Sunday there instead, on both sides -- not a mismatch). The 2016 CDW
+ decree ("Sanctae Mariae Magdalenae", 3 June 2016, Prot. n. 708/2015, AAS
+ 108 (2016) 798-799) raised her to FEAST -- colitur's own
+ data/of/amendments/005-mary-magdalene-rank.sexp applies it (band 70, not
+ 100/110); litcal's grade text shows no sign of applying it. Verdict
+ "litcal". *)
+let is_l5_mary_magdalene (l : litcal_row) = String.equal l.event_key "StMaryMagdalene"
+
+(* L6/L7 -- a genuine, UNADJUDICATED tie-break, found live: Easter 2033 is
+ 17 April, which puts the movable Solemnity of the Sacred Heart (Easter +
+ 68) on 24 June, the SAME fixed date as the Nativity of St John the
+ Baptist -- both Tabula I.3, band 30, an exact tie.
+ {!Colitur_kernel.Precedence.resolve}'s own tie-break (precedence.ml's
+ [compare_by], [Slug.compare] when bands are equal -- confirmed by
+ reading that function directly, not inferred) hands the day to
+ "birth-of-saint-john-the-baptist" alphabetically, and
+ {!Rite_of.Precedence_of.disposition} then Transfers the loser (a losing
+ Sollemnitas always is) to the next free day, landing Sacred Heart on 25
+ June. litcal's own answer is the OPPOSITE: it keeps Sacred Heart on its
+ natural 24 June and instead shows "NativityJohnBaptist" a day EARLY, on
+ 23 June (and its own Immaculate Heart of Mary, independently anchored at
+ Easter + 69, is unaffected either way -- unwitnessed here since
+ "ImmaculateHeart" carries no [identity_map] entry). NEITHER side's
+ choice is dictated by any citation this task found: the Tabula's own
+ text ranks both candidates at the identical entry, and nothing in the
+ Normae or IGMR extracts a Solemnity-of-the-Lord-outranks-a-
+ Solemnity-of-a-Saint rule WITHIN one Tabula entry the way, e.g., RG
+ 112(a) does on the EF side for a narrower case. Verdict "open" --
+ genuinely unresolved, not attributed to either engine, and NOT fixed
+ here (a kernel-level tie-break policy is out of this task's scope
+ regardless). Two rows: [NativityJohnBaptist] (23 June) fails BOTH grade
+ (colitur observes a plain feria there, band 130) and identity;
+ [SacredHeart] (24 June) matches grade by coincidence (colitur's actual
+ occupant, John Baptist, is ALSO Tabula I.3/band 30) but fails identity;
+ [ImmaculateHeart] (25 June) fails grade only (colitur's actual occupant
+ there, the transferred Sacred Heart, is band 30, not litcal's expected
+ Memorial band). *)
+let is_l6_2033_tie_grade (l : litcal_row) =
+ (String.equal l.event_key "NativityJohnBaptist" && String.equal l.date "2033-06-23")
+ || (String.equal l.event_key "ImmaculateHeart" && String.equal l.date "2033-06-25")
+
+let is_l7_2033_tie_identity (l : litcal_row) =
+ (String.equal l.event_key "NativityJohnBaptist" && String.equal l.date "2033-06-23")
+ || (String.equal l.event_key "SacredHeart" && String.equal l.date "2033-06-24")
+
+(* L8/L9 -- a SECOND, newly-found instance of precedence_of.mli's own
+ documented "KNOWN UNIMPLEMENTED FOURTH RULE" (Normae n. 60's "ad
+ proximiorem diem" -- the NEAREST day, not necessarily the nearest
+ FOLLOWING one -- constrained to forward-only search by
+ {!Colitur_kernel.Rite.t.transfer_target}'s own strictly-later contract,
+ an EF-shaped kernel obligation that mli section names and does not fix).
+ That section's own worked example is St Joseph falling exactly ON Palm
+ Sunday (Normae n. 56(f), anticipated to 18 March); this is a DIFFERENT
+ date shape reaching the SAME underlying limitation: Easter 2035 is 25
+ March, putting St Joseph's fixed 19 March on the MONDAY of Holy Week
+ (Easter - 6, a privileged Tabula I.2 feria, not a Sunday), so Normae
+ n. 5's own "following Monday" rule (keyed to a privileged SUNDAY) does
+ not apply here at all -- this falls straight to n. 60's general rule 3,
+ forward-only on colitur's side, landing Joseph on 3 April (Easter + 9,
+ the Tuesday of Easter's Second Week). litcal's own answer anticipates
+ BACKWARD instead, to 17 March -- the Saturday immediately before Palm
+ Sunday, a generalisation of n. 56(f)'s own underlying principle to a
+ date this task found no primary-source text for -- offered as informative
+ evidence of what a fix would need to produce, not as a citation
+ substituting for one. Verdict "colitur" (a known kernel-level
+ limitation, not proven wrong absent a primary-source ruling for THIS
+ exact date shape) -- NOT fixed here, per this task's own brief. *)
+let is_l8_l9_joseph_2035 (l : litcal_row) = String.equal l.event_key "StJoseph" && String.equal l.date "2035-03-17"
+
+let test_grade_matches_or_is_explained () =
+ let litcal = litcal_rows () in
+ let allow_list = load_allow_list () in
+ let by_id = List.map (fun e -> (e.id, e)) allow_list in
+ let unexplained = ref [] in
+ let checked = ref 0 in
+ let counts = Hashtbl.create 8 in
+ let bump id = Hashtbl.replace counts id (1 + try Hashtbl.find counts id with Not_found -> 0) in
+ List.iter
+ (fun (l : litcal_row) ->
+ if is_l1_triduum l then ()
+ else
+ match expected_bands l.grade_lcl with
+ | None -> ()
+ | Some bands ->
+ incr checked;
+ let day = resolved_of l.date in
+ let band = band_of day in
+ if List.mem band bands then ()
+ else if is_l2_l3_holy_family_2033 l then bump "L2"
+ else if is_l4_trinity_corpus_christi l then bump "L4"
+ else if is_l5_mary_magdalene l then bump "L5"
+ else if is_l6_2033_tie_grade l then bump "L6"
+ else if is_l8_l9_joseph_2035 l then bump "L8"
+ else
+ unexplained :=
+ Printf.sprintf "%s: colitur band=%d, litcal grade=%S (event_key=%S, expected one of [%s])" l.date band
+ l.grade_lcl l.event_key
+ (String.concat "," (List.map string_of_int bands))
+ :: !unexplained)
+ litcal;
+ Alcotest.(check (list string)) "every grade mismatch is named in the allow-list -- none unexplained" []
+ (List.rev !unexplained);
+ Alcotest.(check int) "1800 non-Triduum rows carry a grade this layer can compare" 1800 !checked;
+ List.iter
+ (fun id ->
+ let actual = try Hashtbl.find counts id with Not_found -> 0 in
+ match List.assoc_opt id by_id with
+ | None -> Alcotest.failf "allow-list entry %s is used by the comparator but not declared in %s" id allow_list_path
+ | Some e -> Alcotest.(check int) (Printf.sprintf "%s expected_rows (grade)" id) e.expected_rows actual)
+ [ "L2"; "L4"; "L5"; "L6"; "L8" ]
+
+(* The complement, mirroring [test_unwitnessed_ordinary_time_is_counted]:
+ every row [expected_bands] returns [None] for, classified by which of
+ the two structurally-uninformative shapes it is (see [expected_bands]'s
+ own comment for why each is uninformative rather than merely unbuilt),
+ never silently dropped from the total. *)
+let test_grade_unresolved_is_counted () =
+ let litcal = litcal_rows () in
+ let non_triduum = List.filter (fun l -> not (is_l1_triduum l)) litcal in
+ let weekday = List.filter (fun (l : litcal_row) -> String.equal l.grade_lcl "weekday") non_triduum in
+ let optional = List.filter (fun (l : litcal_row) -> String.equal l.grade_lcl "optional memorial") non_triduum in
+ Alcotest.(check int) "2541 weekday rows are uninformative for grade (see expected_bands)" 2541
+ (List.length weekday);
+ Alcotest.(check int) "5 optional-memorial rows are uninformative for grade (see expected_bands)" 5
+ (List.length optional);
+ Alcotest.(check int) "weekday + optional-memorial + the 1800 checked + 36 Triduum = 4382 total" 4382
+ (List.length weekday + List.length optional + 1800 + 36)
+
+(* ---------------------------------------------------------------------- *)
+(* Task 6: IDENTITY. Narrower than grade -- see [identity_map]'s own *)
+(* comment for exactly why. *)
+(* ---------------------------------------------------------------------- *)
+
+let test_identity_matches_or_is_explained () =
+ let litcal = litcal_rows () in
+ let allow_list = load_allow_list () in
+ let by_id = List.map (fun e -> (e.id, e)) allow_list in
+ let unexplained = ref [] in
+ let checked = ref 0 in
+ let counts = Hashtbl.create 8 in
+ let bump id = Hashtbl.replace counts id (1 + try Hashtbl.find counts id with Not_found -> 0) in
+ List.iter
+ (fun (l : litcal_row) ->
+ if is_l1_triduum l then ()
+ else
+ match Hashtbl.find_opt identity_tbl l.event_key with
+ | None -> ()
+ | Some expected_slug ->
+ incr checked;
+ let day = resolved_of l.date in
+ let actual_slug = Slug.to_string day.LD.observed.Cel.slug in
+ if String.equal actual_slug expected_slug then ()
+ else if is_l2_l3_holy_family_2033 l then bump "L3"
+ else if is_l7_2033_tie_identity l then bump "L7"
+ else if is_l8_l9_joseph_2035 l then bump "L9"
+ else
+ unexplained :=
+ Printf.sprintf "%s: colitur slug=%S, litcal event_key=%S (expected slug=%S)" l.date actual_slug
+ l.event_key expected_slug
+ :: !unexplained)
+ litcal;
+ Alcotest.(check (list string)) "every identity mismatch is named in the allow-list -- none unexplained" []
+ (List.rev !unexplained);
+ Alcotest.(check int) "508 rows carry an event_key this layer individually name-maps" 508 !checked;
+ List.iter
+ (fun id ->
+ let actual = try Hashtbl.find counts id with Not_found -> 0 in
+ match List.assoc_opt id by_id with
+ | None -> Alcotest.failf "allow-list entry %s is used by the comparator but not declared in %s" id allow_list_path
+ | Some e -> Alcotest.(check int) (Printf.sprintf "%s expected_rows (identity)" id) e.expected_rows actual)
+ [ "L3"; "L7"; "L9" ]
+
+(* The complement: every row [identity_map] has no entry for, whether
+ because litcal names an event_key outside the closed FIXED/NAMED set
+ this layer maps (the numbered series -- see [identity_map]'s own
+ comment) or because the row's own grade is one of grade's own two
+ uninformative shapes (a "weekday"/"optional memorial" row never names an
+ event_key this table maps, checked directly below, not assumed) or is
+ the day's own Feast/Memorial that this layer does not individually
+ name-map at all (the bulk of the residue: 189 FEAST + 668 Memorial rows,
+ most of whose event_keys are simply not in [identity_map]). Counted,
+ never silently skipped. *)
+let test_identity_unresolved_is_counted () =
+ let litcal = litcal_rows () in
+ let non_triduum = List.filter (fun l -> not (is_l1_triduum l)) litcal in
+ let unresolved =
+ List.filter (fun (l : litcal_row) -> not (Hashtbl.mem identity_tbl l.event_key)) non_triduum
+ in
+ Alcotest.(check int) "3838 non-Triduum rows carry no individually name-mapped event_key" 3838
+ (List.length unresolved);
+ Alcotest.(check int) "unresolved + the 508 checked = 4346 non-Triduum rows" 4346
+ (List.length unresolved + 508)
+
+(* ---------------------------------------------------------------------- *)
+(* The whole allow-list file, taken as a whole: every id it declares is *)
+(* recognised by exactly one comparator above (L1 season, L2 grade, L3 *)
+(* identity) -- no orphan entry a comparator no longer references, and no *)
+(* comparator silently reading an id this file does not declare (each *)
+(* comparator's own [List.assoc_opt] already fails loudly for that half). *)
+(* ---------------------------------------------------------------------- *)
+
+let recognized_allow_ids = [ "L1"; "L2"; "L3"; "L4"; "L5"; "L6"; "L7"; "L8"; "L9" ]
+
+let test_allow_list_has_no_orphan_entries () =
+ let allow_list = load_allow_list () in
+ let declared = List.sort compare (List.map (fun e -> e.id) allow_list) in
+ Alcotest.(check (list string)) "every declared id is recognised by a comparator, and vice versa"
+ (List.sort compare recognized_allow_ids) declared
+
let suite =
( "litcal-of",
[ Alcotest.test_case "fixture checksum" `Quick test_fixture_checksum;
Alcotest.test_case "dates align" `Quick test_dates_align;
Alcotest.test_case "season matches or is explained" `Quick test_season_matches_or_is_explained;
Alcotest.test_case "Ordinary Time week matches exactly where witnessed" `Quick test_ordinary_time_week_matches;
- Alcotest.test_case "unwitnessed Ordinary Time is counted, not skipped" `Quick test_unwitnessed_ordinary_time_is_counted
+ Alcotest.test_case "unwitnessed Ordinary Time is counted, not skipped" `Quick test_unwitnessed_ordinary_time_is_counted;
+ Alcotest.test_case "grade matches or is explained" `Quick test_grade_matches_or_is_explained;
+ Alcotest.test_case "grade-unresolved rows are counted, not skipped" `Quick test_grade_unresolved_is_counted;
+ Alcotest.test_case "identity matches or is explained" `Quick test_identity_matches_or_is_explained;
+ Alcotest.test_case "identity-unresolved rows are counted, not skipped" `Quick test_identity_unresolved_is_counted;
+ Alcotest.test_case "allow-list has no orphan entries" `Quick test_allow_list_has_no_orphan_entries
] )
diff --git a/test/test_validate_of.ml b/test/test_validate_of.ml
new file mode 100644
index 0000000..a8a6001
--- /dev/null
+++ b/test/test_validate_of.ml
@@ -0,0 +1,323 @@
+(* Task 6 (2026-08-26-colitur-of-phases-3-5): Layer 2 (the property harness,
+ {!Colitur_kernel.Validate.run}) run against the REAL, assembled OF rite
+ ({!Rite_of.context} -- data/of/calendar-2002.sexp + all 13 amendments +
+ the real lectionary, exactly what `colitur day --rite of` assembles),
+ matching test_validate.ml's own EF harness: a 200-year QCheck sample by
+ default, all 8 417 years (1583..9999) under [COLITUR_EXHAUSTIVE_SWEEP=1].
+
+ WHY A SEPARATE FILE, not more of test_rite_of.ml (Task 5's own file):
+ Task 5 already wires [Validate.run] for OF and asserts it on four
+ landmark years, the domain edges, and a 46-year (2005-2050) sample --
+ real, valuable coverage, but neither a QCheck property over the WHOLE
+ domain nor the committed exhaustive sweep the EF side's own
+ test_validate.ml carries. This file is that missing piece, one rite
+ down, not a replacement for Task 5's own tests (which stay as they are,
+ including their own three pinned defects -- see below).
+
+ THE THREE KNOWN, PINNED-NOT-FIXED GAPS (Task 5's own report; do not
+ relitigate here, only avoid papering over them):
+ 1. Normae n. 35(a)'s Holy Family fallback is unreached whenever
+ Christmas Day is itself a Sunday (test_rite_of.ml's own
+ [is_known_holy_family_fallback_gap]/
+ [test_holy_family_fallback_1583_known_wrong_ferial]) -- fires on
+ roughly one year in seven, first hit at 1583.
+ 2. The lectionary (data/of/lectionary.sexp) was audited against only one
+ civil year (2026) -- surfaces here as [Validate]'s own
+ ["citations-unresolved"]/["formulary"] gap on 25 December every year
+ (test_rite_of.ml's own [is_known_nativity_gap]), and, more broadly,
+ as a citation-chain gap this file's own comparators (which never
+ touch citations/formulary at all -- see the "what this layer cannot
+ see" note at the end) cannot see beyond that one symptom either way.
+ 3. St Joseph / Palm Sunday (Normae n. 56(f)) -- invisible to
+ [Validate.run] entirely: the impeded solemnity is still transferred
+ exactly once, to SOME later date, so no structural check
+ ("lost"/"duplicated"/"unconverged"/"observed") ever fires for it --
+ only a value-level check (which day it lands on) could catch it, and
+ this file adds none. Named here so a reader does not go looking for
+ a fourth predicate that would never fire.
+
+ Predicates 1 and 2 are duplicated from test_rite_of.ml verbatim (not
+ shared through a .mli -- the same discipline every Ordo/oracle test file
+ in this project already states for itself), so THIS file's own gap
+ handling cannot drift from Task 5's silently. *)
+
+module Val = Colitur_kernel.Validate
+module Layer = Colitur_kernel.Layer
+module Overlay = Colitur_kernel.Overlay
+module Cal = Colitur_kernel.Calendar
+module LD = Colitur_kernel.Liturgical_day
+module Temporal = Colitur_kernel.Temporal
+module Date = Colitur_kernel.Date
+module V = Rite_of.Vocab_of
+
+let calendar_path = "../data/of/calendar-2002.sexp"
+let amendments_dir = "../data/of/amendments/"
+let of_lectionary_path = "../data/of/lectionary.sexp"
+
+let amendment_files =
+ [ "001-padre-pio.sexp"; "002-juan-diego-cuauhtlatoatzin.sexp"; "003-our-lady-of-guadalupe.sexp";
+ "004-john-xxiii-john-paul-ii.sexp"; "005-mary-magdalene-rank.sexp"; "006-mary-mother-of-the-church.sexp";
+ "007-paul-vi.sexp"; "008-our-lady-of-loreto.sexp"; "009-faustina-kowalska.sexp";
+ "010-narek-avila-hildegard.sexp"; "011-martha-mary-lazarus.sexp"; "012-teresa-of-calcutta.sexp";
+ "013-john-henry-newman.sexp" ]
+
+let real_of_layer =
+ let base =
+ match Layer.load V.rank_of_sexp calendar_path with
+ | Ok l -> l
+ | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" calendar_path e)
+ in
+ let overlays =
+ List.map
+ (fun name ->
+ let path = amendments_dir ^ name in
+ match Overlay.load V.rank_of_sexp path with
+ | Ok o -> o
+ | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" path e))
+ amendment_files
+ in
+ let layer, diagnostics = Overlay.merge base overlays in
+ if diagnostics <> [] then
+ failwith
+ (Printf.sprintf "unexpected amendment diagnostics: %s"
+ (String.concat "; " (List.map Overlay.diagnostic_to_string diagnostics)));
+ layer
+
+let real_of_lectionary =
+ match Colitur_kernel.Lectionary.load of_lectionary_path with
+ | Ok l -> l
+ | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" of_lectionary_path e)
+
+let real_of_rite = Rite_of.context ~lectionary:real_of_lectionary
+
+let run year = Val.run real_of_rite real_of_layer ~year
+
+(* Duplicated verbatim from test_rite_of.ml -- see this file's own header
+ for why. *)
+let ends_with ~suffix s =
+ let ls = String.length s and lx = String.length suffix in
+ ls >= lx && String.sub s (ls - lx) lx = suffix
+
+let is_known_nativity_gap (f : Val.failure) =
+ (f.Val.check = "citations-unresolved" || f.Val.check = "formulary") && ends_with ~suffix:"12-25" f.Val.date
+
+let contains ~substring s =
+ let ls = String.length s and lx = String.length substring in
+ let rec go i = i + lx <= ls && (String.sub s i lx = substring || go (i + 1)) in
+ lx = 0 || go 0
+
+let is_known_holy_family_fallback_gap (f : Val.failure) =
+ f.Val.check = "anchor" && contains ~substring:"of-holy-family" f.Val.detail
+
+let is_known_gap f = is_known_nativity_gap f || is_known_holy_family_fallback_gap f
+
+let unexplained_failures year = List.filter (fun f -> not (is_known_gap f)) (run year)
+
+let check_year_allowing_known_gaps year =
+ match unexplained_failures year with
+ | [] -> ()
+ | fs ->
+ Alcotest.failf "%d: %s" year
+ (String.concat "; " (List.map Val.failure_to_string (List.filteri (fun i _ -> i < 5) fs)))
+
+(* ---------------------------------------------------------------------- *)
+(* Landmark years and the domain edges, mirroring test_validate.ml's own *)
+(* [test_landmark_years]/[test_year_9999_does_not_raise] one rite down. *)
+(* ---------------------------------------------------------------------- *)
+
+let test_landmark_years () = List.iter check_year_allowing_known_gaps [ 1583; 2026; 2035; 9998 ]
+
+(* 9999: the liturgical year opening there continues into out-of-domain
+ civil year 10000, so [run]/[Calendar.year] clamp the walk to 31 December
+ 9999 rather than raising -- the truncated season run is *expected* to
+ fail the "seasons" check (it never reaches Advent's own end, let alone
+ Ordinary Time's own week 34), exactly as EF's own
+ [test_year_9999_does_not_raise] pins. Distinguished from the THREE known
+ gaps above (still filtered, since 25 December 9999 and a possible
+ Christmas-Day-is-Sunday shape can both still occur inside the truncated
+ walk) -- only "seasons" is additionally allowed here, and only here. *)
+let test_year_9999_does_not_raise () =
+ let fs = List.filter (fun f -> not (is_known_gap f)) (run 9999) in
+ Alcotest.(check bool) "no coverage failures (temporal stayed total through the clamp)" true
+ (not (List.exists (fun f -> f.Val.check = "coverage") fs));
+ Alcotest.(check bool) "seasons check flags the truncated final year as incomplete" true
+ (List.exists (fun f -> f.Val.check = "seasons") fs);
+ Alcotest.(check (list string)) "nothing OTHER than the documented seasons truncation (and the three known \
+ gaps, already filtered) fired"
+ [ "seasons" ]
+ (List.sort_uniq compare (List.map (fun f -> f.Val.check) fs))
+
+(* ---------------------------------------------------------------------- *)
+(* THE CONFIDENCE-TO-9999 CORE: random years across the whole domain, *)
+(* mirroring test_validate.ml's own [prop_invariants] exactly, one rite *)
+(* down -- 200 samples by default; every EXHAUSTIVE year under *)
+(* [COLITUR_EXHAUSTIVE_SWEEP=1] (below). Filtered of the three known gaps, *)
+(* same discipline [check_year_allowing_known_gaps] already applies to the *)
+(* landmark years -- a property that asserted [run y = []] UNFILTERED *)
+(* would not test anything new (it would just fail on ~1/7 of its own *)
+(* samples, the Holy Family gap's own real incidence), and one that *)
+(* filtered EVERYTHING unconditionally would risk hiding a genuinely NEW *)
+(* failure behind the same three names -- which is exactly why *)
+(* [is_known_gap] is the narrow, field-checked pair of predicates above, *)
+(* not a blanket "ignore anything on 25 December" rule. *)
+let prop_invariants =
+ QCheck.Test.make ~count:200 ~name:"OF temporal invariants hold across 1583..9998 (modulo the three known, \
+ pinned gaps)"
+ (QCheck.int_range 1583 9998)
+ (fun y -> unexplained_failures y = [])
+
+let colitur_exhaustive_sweep_env = "COLITUR_EXHAUSTIVE_SWEEP"
+
+(* Every year 1583..9999, not a sample -- same env-var gate and the same
+ reasoning test_validate.ml's own [test_exhaustive_domain_sweep] and
+ test_temporal_of.ml's own [test_exhaustive_domain_sweep] both already
+ give: `dune test`'s default run stays fast and reports the skip
+ honestly; `COLITUR_EXHAUSTIVE_SWEEP=1 dune test --force` runs the real
+ sweep. *)
+(* ---------------------------------------------------------------------- *)
+(* "Ordinary Time weeks 1..34, final week always 34" and "the year is *)
+(* covered once, no gaps" -- ONE combined helper, ONE {!Cal.year} call, *)
+(* deliberately, not two: {!Cal.year} was MEASURED (not assumed) at ~17ms *)
+(* per civil year for the real OF rite/data (a scratch timing harness, not *)
+(* committed -- {!Val.run} itself costs only ~2ms more on top, dominated *)
+(* by the SAME resolution call), so an 8 416-year exhaustive sweep costs *)
+(* ~2.5 MINUTES per INDEPENDENT full-domain pass over this data. A naive *)
+(* THIRD independent exhaustive loop for each of these two properties *)
+(* (mirroring their own separate QCheck properties below one-for-one) *)
+(* would have added roughly 5 more minutes to `make check` for marginal *)
+(* extra confidence over what the 200-sample properties already give -- *)
+(* measured, then rejected as disproportionate, not overlooked. Folded *)
+(* into {!test_exhaustive_domain_sweep}'s own loop instead: ONE extra *)
+(* {!Cal.year} call per year, alongside {!run}'s own internal one, so the *)
+(* total exhaustive cost here is ~2x one full-domain pass, not 3x. *)
+let ot_and_coverage_of_year year =
+ let days = Cal.year real_of_rite real_of_layer year |> Array.to_list in
+ let dates = List.map (fun (d : (V.season, V.rank) LD.t) -> d.LD.date) days in
+ let sorted = List.sort Date.compare dates in
+ let rec no_dup_no_gap = function
+ | a :: (b :: _ as rest) -> Date.to_rata b - Date.to_rata a = 1 && no_dup_no_gap rest
+ | _ -> true
+ in
+ let unique_count = List.length (List.sort_uniq Date.compare dates) in
+ let coverage_ok = no_dup_no_gap sorted && unique_count = List.length dates && List.length dates > 0 in
+ let weeks =
+ List.filter_map
+ (fun (d : (V.season, V.rank) LD.t) ->
+ match d.LD.temporal.Temporal.season with V.Ordinary_time -> d.LD.temporal.Temporal.week | _ -> None)
+ days
+ in
+ (coverage_ok, weeks)
+
+(* 9999 is handled the same way [test_year_9999_does_not_raise] already
+ does: its own truncated walk never reaches Ordinary Time's second block
+ at all (legitimately [weeks = []] there), so the "reaches 34" half is
+ checked only for 1583..9998, matching {!check_year_allowing_known_gaps}'s
+ own domain. *)
+let ordinary_time_weeks_ok weeks = List.for_all (fun n -> n >= 1 && n <= 34) weeks
+
+let prop_ordinary_time_weeks_bounded_and_reach_34 year =
+ let _, weeks = ot_and_coverage_of_year year in
+ ordinary_time_weeks_ok weeks && List.mem 34 weeks
+
+let prop_ot_weeks =
+ QCheck.Test.make ~count:200 ~name:"OF: Ordinary Time weeks are 1..34 and the final week is always 34 \
+ (through Rite_of.context/Calendar.year)"
+ (QCheck.int_range 1583 9998)
+ prop_ordinary_time_weeks_bounded_and_reach_34
+
+(* "Exactly one observed office per day" and "the year covered once, no
+ gaps" -- {!Cal.year}'s own array is built by walking [start, stop] one
+ civil day at a time (calendar.ml), so both are guaranteed BY
+ CONSTRUCTION for any single call; what this property adds is proving
+ that construction actually holds for the REAL rite/data (not a
+ placeholder), and, for the "one observed office" half, that
+ {!Colitur_kernel.Liturgical_day.t.observed} is never ALSO one of its own
+ day's commemorations/omissions ({!Val.run}'s own ["observed"] check,
+ already exercised by every [run y = []] assertion in this file -- OF's
+ own [commemorations] is permanently [] by design (Precedence_of.mli's
+ own [admit]), so this is really only ever checking [observed] against
+ [omitted], the transfer-departure shape). *)
+let prop_year_covered_once_no_gaps year =
+ let coverage_ok, _ = ot_and_coverage_of_year year in
+ coverage_ok
+
+let prop_coverage =
+ QCheck.Test.make ~count:200 ~name:"OF: Calendar.year covers its own liturgical year exactly once, no gaps, \
+ no duplicates (Rite_of.context, real data)"
+ (QCheck.int_range 1583 9998)
+ prop_year_covered_once_no_gaps
+
+(* MEASURED (a scratch timing harness, not committed): folding the extra
+ {!Cal.year} call for OT-weeks/coverage into THIS loop, as an early
+ version of this test did, roughly DOUBLED the sweep's own wall-clock
+ cost (~365s vs ~180s for {!run} alone, both measured against the same
+ real data) for confidence this file's own two 200-sample QCheck
+ properties ([prop_ot_weeks]/[prop_coverage], run on every default `dune
+ test`) and test_temporal_of.ml's own PRE-EXISTING exhaustive sweep (the
+ OT-week bound specifically, proven domain-wide already, at the
+ Temporal_of level -- see [prop_ot_weeks]'s own comment) already
+ substantially cover. Measured, then deliberately NOT kept: this loop
+ now costs ONE {!run} call per year, matching the EF harness's own
+ [test_exhaustive_domain_sweep] shape exactly, not a rite-specific
+ multiple of it. *)
+let test_exhaustive_domain_sweep () =
+ if Sys.getenv_opt colitur_exhaustive_sweep_env = None then Alcotest.skip ()
+ else begin
+ let holy_family_gap_years = ref 0 in
+ let nativity_gap_years = ref 0 in
+ for y = 1583 to 9998 do
+ let fs = run y in
+ let hf = List.exists is_known_holy_family_fallback_gap fs in
+ let nat = List.exists is_known_nativity_gap fs in
+ if hf then incr holy_family_gap_years;
+ if nat then incr nativity_gap_years;
+ match List.filter (fun f -> not (is_known_gap f)) fs with
+ | [] -> ()
+ | unexpected ->
+ Alcotest.failf "%d: %s" y
+ (String.concat "; " (List.map Val.failure_to_string (List.filteri (fun i _ -> i < 5) unexpected)))
+ done;
+ (* 9999 itself: NOT [check_year_allowing_known_gaps] (that predicate
+ demands NO unexpected failures at all, and the "seasons" truncation
+ IS expected here, exactly as [test_year_9999_does_not_raise] above
+ already asserts) -- the identical distinction test_validate.ml's own
+ [test_exhaustive_domain_sweep] draws between its own [check_year]
+ (ordinary years) and its own special-cased [run 9999] handling. *)
+ let fs_9999 = run 9999 in
+ Alcotest.(check bool) "9999: no coverage failures (temporal stayed total through the clamp)" true
+ (not (List.exists (fun f -> f.Val.check = "coverage") fs_9999));
+ Alcotest.(check bool) "9999: seasons check flags the truncated final year as incomplete" true
+ (List.exists (fun f -> f.Val.check = "seasons") fs_9999);
+ Alcotest.(check (list string)) "9999: nothing OTHER than the documented seasons truncation (and the three \
+ known, pinned gaps) fired"
+ [ "seasons" ]
+ (List.sort_uniq compare
+ (List.map (fun f -> f.Val.check) (List.filter (fun f -> not (is_known_gap f)) fs_9999)));
+ (* Both known gaps are real and not vacuous across the FULL domain, not
+ merely on the handful of years the sampled property happens to draw
+ -- the Nativity gap fires on literally EVERY year (25 December
+ always exists); the Holy Family gap fires on roughly one year in
+ seven (whenever 25 December is a Sunday). Pinned as a range, not an
+ exact count, deliberately: the exact figure is a real, computable
+ fact about the Gregorian calendar's own 400-year cycle, but pinning
+ it to the digit would make this test fail the moment a future
+ COLITUR_EXHAUSTIVE_SWEEP run's own domain bounds shift by even one
+ year at either edge, for a reason having nothing to do with
+ colitur's own correctness. *)
+ Alcotest.(check int) "the Nativity citation/formulary gap fires on every one of the 8 416 swept years"
+ 8416 !nativity_gap_years;
+ Alcotest.(check bool) "the Holy Family fallback gap fires on a real, non-trivial fraction of years \
+ (roughly one in seven)"
+ true
+ (!holy_family_gap_years > 1000 && !holy_family_gap_years < 1400)
+ end
+
+let suite =
+ ( "Validate (OF, real data: Rite_of.context)",
+ [ Alcotest.test_case "landmark years validate cleanly (modulo the three known gaps)" `Quick test_landmark_years;
+ Alcotest.test_case "year 9999 does not raise; seasons flags the clamp, nothing else (beyond the known \
+ gaps) fires" `Quick
+ test_year_9999_does_not_raise;
+ Alcotest.test_case "exhaustive domain sweep (1583..9999), committed not sampled" `Slow
+ test_exhaustive_domain_sweep ]
+ @ List.map QCheck_alcotest.to_alcotest [ prop_invariants; prop_ot_weeks; prop_coverage ] )