summaryrefslogtreecommitdiff
path: root/test/test_litcal_of.ml
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/test_litcal_of.ml
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/test_litcal_of.ml')
-rw-r--r--test/test_litcal_of.ml553
1 files changed, 537 insertions, 16 deletions
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
] )