From 68cff511cd79ca5450c4f21dffba1b1e4ac93389 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 16:23:01 +0200 Subject: rite(ef): fix duplicate slugs and omitted weeks in the temporal cycle Two correctness bugs in Temporal_ef, both only visible across many years, not a single point assertion: 1. Duplicate slugs within one liturgical year. Christmastide has no numbered weeks, so the ferial fallback's -- scheme collapsed every feria in it to literal week "0". Since colitur's Christmastide runs 25 Dec - 13 Jan (RG 72-73, a deliberate divergence from lectio), the same weekday recurs across that span and the keys collided (e.g. ef-christmas-0-saturday on three different dates). Fixed with a dedicated christmastide_feria_slug that splits the span into four sub-stretches, prioritising compatibility with lectio's own keys wherever lectio has one: - 26-28 Dec keeps lectio's existing ef-christmas-0-. - 2-5 Jan becomes ef-christmas-1- -- lectio collapses this indistinguishably into the same key as the stretch above, so there is nothing to preserve; a colitur-only lectionary gap. - 7-13 Jan splits at the actual first-Sunday-after-Epiphany origin: on/after it, this is genuinely week 1 of Time after Epiphany and takes lectio's own ef-time-after-epiphany-1- (which also can't collide with that season's own later week-1 ferias, since it's the same computation). Before it (0-6 days, whenever Epiphany doesn't fall on a Saturday), a first attempt at labelling this "week 1" too, matching a literal reading of lectio's behaviour, was verified empirically (a throwaway sweep of the full 1583..9998 domain) to reproduce duplicates in most years -- so this remainder is its own ef-christmas-2-, a further colitur-only gap. Verified with the same throwaway sweep: zero duplicate slugs across 1583..9998 after the fix. 2. named's week field was set by hand on some branches (Passion/Palm Sunday, Easter, Low Sunday, Pentecost and its Vigil, Christ the King) and left at None on others (Ascension and its Vigil, Corpus Christi, Sacred Heart) even though all of them sit inside a numbered season run. named no longer carries a week at all -- temporal now calls week itself for every day, named or not, so "a named day inside a run carries that run's week" holds by construction rather than by remembering to set it on each branch. temporal.mli's week field doc is reworded to state the actual rule. Covering tests: point assertions for all four Christmastide sub-stretches; a QCheck property scanning random years for any duplicate slug within a liturgical year (excluding the deliberate resumed-Sunday reuse); point assertions for the four previously-None days now carrying their week (first to fail without the fix: Ascension Vigil, expected Some 6, got None); a QCheck property asserting temporal's week equals week for every day of the year, replacing a prior property whose fallback made it structurally incapable of detecting an omitted week. Also: cite RG 91 e18 for the September/Advent Ember days matching lectio and flag the Lent/Whitsun Ember and Rogation slugs as colitur-only lectionary gaps inline, matching the existing Nativity-vigil/octave-day convention; cite RG 117/123/127/128/131 for season colours and Gaudete/Laetare rose; drop the unreachable Passiontide arm from the Sunday-rank match (Passiontide has only two Sundays and both are already named above, so no Passiontide Sunday ever reaches that fallback). --- test/test_temporal_ef.ml | 139 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 105 insertions(+), 34 deletions(-) (limited to 'test/test_temporal_ef.ml') diff --git a/test/test_temporal_ef.ml b/test/test_temporal_ef.ml index f99626c..2ad93e8 100644 --- a/test/test_temporal_ef.ml +++ b/test/test_temporal_ef.ml @@ -55,7 +55,7 @@ let test_seasons () = Alcotest.(check string) "Trinity 31 May 2026" "time-after-pentecost" (season_str (d 2026 5 31)) let named_slug dt = match T.named dt with - | Some (_, slug, _, _, _) -> slug + | Some (_, slug, _, _) -> slug | None -> "" let test_named_feasts () = @@ -132,10 +132,12 @@ let test_week_sunday_slug_agree () = (fun n -> let dt = D.add_days pentecost (7 * n) in let slug = sunday_slug_of dt in - let embedded = Scanf.sscanf slug "ef-time-after-pentecost-sunday-%d" (fun k -> k) in - Alcotest.(check (option int)) - (Printf.sprintf "week %d after Pentecost matches slug" n) - (Some embedded) (T.week dt)) + match Scanf.sscanf_opt slug "ef-time-after-pentecost-sunday-%d" (fun k -> k) with + | None -> Alcotest.failf "slug %S did not match the expected ...-sunday-N pattern" slug + | Some embedded -> + Alcotest.(check (option int)) + (Printf.sprintf "week %d after Pentecost matches slug" n) + (Some embedded) (T.week dt)) [ 1; 5; 10; 15; 20 ] (* The resumed-Sunday tail: when Easter is early there are more than 23 Sundays @@ -162,16 +164,40 @@ let test_resumed_sundays () = in Alcotest.(check bool) "2035 has resumed Epiphany Sundays" true (resumed <> []) -(* Regression for a Task 14 Validate finding: named's own explicit week - numbers (Easter, Low Sunday, Passion/Palm Sunday, Trinity, Pentecost and - its Vigil, Christ the King) must agree with what [week] independently - computes for the same date -- omitting or mis-stating one breaks week - continuity across that day. A general property over every day of many - years, not point assertions on the three days the bug was found on, so the - same drift cannot silently reappear in a future addition to [named]. *) -let prop_named_week_agrees_with_week = +module Cel = Colitur_kernel.Celebration +module Sl = Colitur_kernel.Slug +module Colr = Colitur_kernel.Colour + +let office dt = (T.temporal dt).Colitur_kernel.Temporal.office +let slug_of dt = Sl.to_string (office dt).Cel.slug +let rank_of dt = V.rank_to_string (office dt).Cel.rank +let colour_of dt = Colr.to_string (office dt).Cel.colour +let temporal_week dt = (T.temporal dt).Colitur_kernel.Temporal.week + +(* Regression for a Task 14 Validate finding, reworked (register finding 4): + [named] no longer carries its own week at all -- [temporal] computes it + uniformly via [week] for every day, named or not -- so "a named day inside + a numbered season run carries that run's week" now holds by construction + rather than by a hand-set value on some branches and not others. These four + sat inside a numbered run (Paschaltide week 6, Time after Pentecost weeks 1 + and 2 respectively) but carried [None] under the old convention-based + version; each assertion below would have failed against it (first to fail: + Ascension Vigil, expected [Some 6], got [None]). *) +let test_named_days_carry_their_week () = + Alcotest.(check (option int)) "Ascension Vigil carries week 6" (Some 6) (temporal_week (d 2026 5 13)); + Alcotest.(check (option int)) "Ascension carries week 6" (Some 6) (temporal_week (d 2026 5 14)); + Alcotest.(check (option int)) "Corpus Christi carries week 1" (Some 1) (temporal_week (d 2026 6 4)); + Alcotest.(check (option int)) "Sacred Heart carries week 2" (Some 2) (temporal_week (d 2026 6 12)) + +(* The total replacement for the old property: with [week] removed from + [named]'s own return type, "the day's week" has exactly one source, so this + can be asserted for *every* day, not merely wherever [named] happened to + supply an explicit value -- the old version's [| _ -> true] escape hatch + for every unnamed and every None-week day is gone, and with it the reason + that version could not detect an omission. *) +let prop_temporal_week_matches_week = QCheck.Test.make ~count:200 - ~name:"named's explicit week agrees with week, wherever named gives one" + ~name:"temporal's week always equals week, for every day of the year" (QCheck.int_range 1583 9998) (fun y -> let start = d y 1 1 in @@ -181,22 +207,10 @@ let prop_named_week_agrees_with_week = i >= n || let dt = D.add_days start i in - (match T.named dt with - | Some (_, _, _, _, Some w) -> T.week dt = Some w - | _ -> true) - && check (i + 1) + temporal_week dt = T.week dt && check (i + 1) in check 0) -module Cel = Colitur_kernel.Celebration -module Sl = Colitur_kernel.Slug -module Colr = Colitur_kernel.Colour - -let office dt = (T.temporal dt).Colitur_kernel.Temporal.office -let slug_of dt = Sl.to_string (office dt).Cel.slug -let rank_of dt = V.rank_to_string (office dt).Cel.rank -let colour_of dt = Colr.to_string (office dt).Cel.colour - let test_ferial_slugs_and_ranks () = (* Ferias key on season-week-weekday, matching lectio's lectionary keys. *) Alcotest.(check string) "Lent feria" "ef-lent-3-monday" (slug_of (d 2026 3 9)); @@ -271,15 +285,69 @@ let test_colours () = Alcotest.(check string) "Gaudete is rose" "rose" (colour_of (d 2026 12 13)); Alcotest.(check string) "Laetare is rose" "rose" (colour_of (d 2026 3 15)) +(* Register finding 1 / controller finding A: Christmastide's ferial fallback + used to collapse every day to literal week "0" (no numbered weeks in + Christmastide), and because colitur's Christmastide spans 25 Dec - 13 Jan, + the same weekday recurred and collided. 2026: Easter 5 Apr, Epiphany + (6 Jan) is a Tuesday, so the actual first-Sunday-after-Epiphany origin is + 11 Jan -- exercising all four sub-stretches of the fix. *) +let test_christmastide_feria_slugs () = + Alcotest.(check string) "26 Dec (Sat)" "ef-christmas-0-saturday" (slug_of (d 2026 12 26)); + Alcotest.(check string) "28 Dec (Mon)" "ef-christmas-0-monday" (slug_of (d 2026 12 28)); + Alcotest.(check string) "2 Jan (Fri)" "ef-christmas-1-friday" (slug_of (d 2026 1 2)); + Alcotest.(check string) "5 Jan (Mon)" "ef-christmas-1-monday" (slug_of (d 2026 1 5)); + (* 7-10 Jan precede the actual origin Sunday (11 Jan): colitur-only, not + lectio's "week 1" key, precisely to avoid colliding with 12-13 Jan below. *) + Alcotest.(check string) "7 Jan (Wed, before the origin)" "ef-christmas-2-wednesday" (slug_of (d 2026 1 7)); + Alcotest.(check string) "10 Jan (Sat, before the origin)" "ef-christmas-2-saturday" (slug_of (d 2026 1 10)); + (* 12-13 Jan are on/after the origin: genuinely week 1, lectio's key. *) + Alcotest.(check string) "12 Jan (Mon, on/after the origin)" "ef-time-after-epiphany-1-monday" + (slug_of (d 2026 1 12)); + Alcotest.(check string) "13 Jan (Tue, on/after the origin)" "ef-time-after-epiphany-1-tuesday" + (slug_of (d 2026 1 13)) + +(* The general property behind the fix above: no two dates in one liturgical + year may share a slug, except the deliberate resumed-Sunday reuse (see + test_resumed_sundays). Random years across the whole domain, not just + 2026 -- the original bug (controller finding A) was found by grepping one + year's CLI output for duplicates, and other years could hide others. *) +let is_resumable_sunday_slug s = + let prefix = "ef-time-after-epiphany-sunday-" in + String.length s > String.length prefix && String.sub s 0 (String.length prefix) = prefix + +let prop_slugs_unique_within_liturgical_year = + QCheck.Test.make ~count:200 + ~name:"no two dates in one liturgical year share a slug, apart from the resumed-Sunday reuse" + (QCheck.int_range 1583 9998) + (fun y -> + let start = T.year_start y in + let stop = D.add_days (T.year_start (y + 1)) (-1) in + let n = D.to_rata stop - D.to_rata start + 1 in + let seen = Hashtbl.create 512 in + let rec check i = + i >= n + || + let s = slug_of (D.add_days start i) in + (is_resumable_sunday_slug s + || (not (Hashtbl.mem seen s)) + && ( + Hashtbl.replace seen s (); + true)) + && check (i + 1) + in + check 0) + let test_totality () = - (* Every day of 2026 yields an office, and every slug is well-formed. *) + (* Every day of 2026 yields an office without raising. Not a slug + re-validation -- Slug.t is a private string validated on construction, + so round-tripping to_string/of_string on an existing value is a + tautology (the same vacuous check Validate's own comment identifies and + explains for the same reason). This still has value: it forces full + evaluation of [temporal] across a whole year and would fail if any day + in it raised. *) let jan1 = d 2026 1 1 in for i = 0 to 364 do - let dt = D.add_days jan1 i in - let s = slug_of dt in - match Sl.of_string s with - | Ok _ -> () - | Error e -> Alcotest.failf "%s: %s" (D.to_iso8601 dt) e + ignore (T.temporal (D.add_days jan1 i)) done let suite_extra = @@ -297,6 +365,8 @@ let suite_extra = Alcotest.test_case "ember days" `Quick test_ember_days; Alcotest.test_case "rogations" `Quick test_rogations; Alcotest.test_case "colours" `Quick test_colours; + Alcotest.test_case "christmastide feria slugs" `Quick test_christmastide_feria_slugs; + Alcotest.test_case "named days carry their week" `Quick test_named_days_carry_their_week; Alcotest.test_case "totality" `Quick test_totality ] let suite = @@ -304,4 +374,5 @@ let suite = [ Alcotest.test_case "vocab roundtrips" `Quick test_vocab_roundtrips; Alcotest.test_case "slug words" `Quick test_slug_words ] @ suite_extra - @ List.map QCheck_alcotest.to_alcotest [ prop_named_week_agrees_with_week ] ) + @ List.map QCheck_alcotest.to_alcotest + [ prop_temporal_week_matches_week; prop_slugs_unique_within_liturgical_year ] ) -- cgit v1.3