diff options
Diffstat (limited to 'test/test_litcal_of.ml')
| -rw-r--r-- | test/test_litcal_of.ml | 553 |
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 ] ) |