diff options
Diffstat (limited to 'test/test_temporal_ef.ml')
| -rw-r--r-- | test/test_temporal_ef.ml | 105 |
1 files changed, 62 insertions, 43 deletions
diff --git a/test/test_temporal_ef.ml b/test/test_temporal_ef.ml index 477651c..751abd2 100644 --- a/test/test_temporal_ef.ml +++ b/test/test_temporal_ef.ml @@ -351,67 +351,86 @@ let test_christmastide_feria_slugs () = This guard is therefore entirely EF-specific and lives here, against [T.named] and [T.anchors] directly -- both accessible in this file, not - through the [Rite.t] boundary. *) + through the [Rite.t] boundary. -(* "Easter-derived" is discovered mechanically from [named] itself, not - hand-copied from either [named]'s or [anchors]'s own source: scan a - window of dates around a year's Easter and keep whatever [named] answers - [Some] for. [named] returns [Some] only for its ~20 genuinely proper/named - days -- ordinary Sundays and ferias are produced by other functions - entirely, in [temporal]'s [None] branch -- so this cannot pick up an - ordinary week's slug by accident regardless of window width. [-60, +75] - safely isolates the Easter-relative half of [named] from its - fixed-calendar half: exhaustively checked over 1583..2500, the nearest - fixed named date to Easter (6 January, Epiphany) is never less than 75 - days before the EARLIEST possible Easter (22 March), so a 60-day backward - reach cannot cross into it even in the closest year, while the window - still comfortably covers [named]'s actual Easter-relative range (Ash - Wednesday at Easter-46 the earliest, Sacred Heart at Easter+68 the - latest). *) -let easter_relative_named_slugs y = - let easter = Colitur_kernel.Computus.gregorian_easter y in + EXTENDED (final fix wave, item 3): the guard originally scanned only a + 60/+75-day window around Easter, so it caught erosion of an + Easter-relative anchor (Ascension, say) but not of a FIXED-date one -- + Nativity, the Nativity vigil, the three Nativity octave days, the + Circumcision, Epiphany -- nor of [christ_the_king], which is neither + fixed nor Easter-relative (the last Sunday of October). Deleting any of + those from [T.anchors] left the whole suite green: Plan 2's carried item + 5 was therefore only half-closed while being reported as closed, and the + worst-covered anchor was exactly the one with the weakest citation + (Christ the King -- oracle-backed, not yet primary-verified when this + note was written; see docs/research/rules-register.md §4/§6, since + primary-verified at RG 17(d) by this same fix wave). Fixed by widening + the scan from an Easter-centred window to the WHOLE civil year: [named] + only ever answers [Some] for its ~20 genuinely proper/named days + (ordinary Sundays and ferias are produced entirely by [temporal]'s own + [None] branch, never by [named]), so scanning every day of the year + cannot pick up an ordinary week's slug by accident any more than the + narrower window could -- it is simply no longer selective about WHICH + kind of named day it is willing to notice. *) + +(* Every slug [named] can produce for civil year [y] -- fixed-date AND + Easter-relative alike -- discovered mechanically by asking [named] itself + about every day of the year (366 days from 1 January, safely covering a + leap year plus one day of spillover into the next, which duplicates + rather than misleads: every slug [named] returns is a year-invariant + string), not hand-copied from either [named]'s or [anchors]'s own + source. *) +let named_slugs_for_year y = + let jan1 = d y 1 1 in List.filter_map - (fun n -> match T.named (D.add_days easter n) with Some (_, slug, _, _) -> Some slug | None -> None) - (List.init 136 (fun i -> i - 60)) + (fun i -> match T.named (D.add_days jan1 i) with Some (_, slug, _, _) -> Some slug | None -> None) + (List.init 366 (fun i -> i)) |> List.sort_uniq compare let anchor_slugs y = List.map fst (T.anchors y) |> List.sort_uniq compare -(* The mechanism both tests below share: which of [named]'s Easter-derived - slugs [anchors] fails to restate. [] means complete. *) -let missing_from_anchors ~named_easter_slugs ~anchors = - List.filter (fun slug -> not (List.mem slug anchors)) named_easter_slugs +(* The mechanism both tests below share: which of [named]'s slugs [anchors] + fails to restate. [] means complete. *) +let missing_from_anchors ~named_slugs ~anchors = + List.filter (fun slug -> not (List.mem slug anchors)) named_slugs (* The real guard: for the domain's own Easter extremes (1598 earliest, 1666 latest -- see test_validate.ml's own [extreme_years], corrected by this - same task) plus an ordinary year, nothing [named] produces at an - Easter-relative offset is missing from [anchors]. *) -let test_anchors_cover_easter_derived_named_days () = + same task) plus an ordinary year, nothing [named] produces -- fixed-date + or Easter-relative -- is missing from [anchors]. *) +let test_anchors_cover_all_named_days () = List.iter (fun y -> let missing = - missing_from_anchors ~named_easter_slugs:(easter_relative_named_slugs y) ~anchors:(anchor_slugs y) + missing_from_anchors ~named_slugs:(named_slugs_for_year y) ~anchors:(anchor_slugs y) in Alcotest.(check (list string)) - (Printf.sprintf "%d: every Easter-derived named slug is restated in anchors" y) + (Printf.sprintf "%d: every named slug is restated in anchors" y) [] missing) [ 1598; 1666; 2026 ] (* Proves the guard above actually has teeth, per this task's negative-fixture - requirement: [T.anchors]'s real slug set with one genuinely Easter-derived - entry ("ef-ascension") struck out must fail [missing_from_anchors] the same - way the real list passes it -- reproducing, in miniature, exactly what - "deleting four entries leaves the whole suite green" (Plan 2, carried item - 5) looked like before this test existed. *) + requirement, now over BOTH shapes of anchor: [T.anchors]'s real slug set + with one Easter-relative entry ("ef-ascension") AND one fixed-date entry + ("ef-nativity") struck out together must fail [missing_from_anchors] the + same way the real list passes it -- reproducing, in miniature, exactly + what "deleting ef-nativity, ef-epiphany and ef-christ-the-king leaves the + whole suite green" (final fix wave, item 3) looked like before this test + existed. *) let test_anchors_erosion_is_caught () = let y = 2026 in - let named_easter_slugs = easter_relative_named_slugs y in - Alcotest.(check bool) "sanity: ef-ascension is genuinely in the Easter-derived set" true - (List.mem "ef-ascension" named_easter_slugs); - let eroded_anchors = List.filter (fun s -> s <> "ef-ascension") (anchor_slugs y) in - Alcotest.(check (list string)) "the erosion is caught: the missing entry is reported, and only it" - [ "ef-ascension" ] - (missing_from_anchors ~named_easter_slugs ~anchors:eroded_anchors) + let named_slugs = named_slugs_for_year y in + Alcotest.(check bool) "sanity: ef-ascension is genuinely a named slug" true + (List.mem "ef-ascension" named_slugs); + Alcotest.(check bool) "sanity: ef-nativity is genuinely a named slug" true + (List.mem "ef-nativity" named_slugs); + let eroded_anchors = + List.filter (fun s -> s <> "ef-ascension" && s <> "ef-nativity") (anchor_slugs y) + in + Alcotest.(check (list string)) + "the erosion is caught: both missing entries are reported, and only them" + [ "ef-ascension"; "ef-nativity" ] + (missing_from_anchors ~named_slugs ~anchors:eroded_anchors) let test_totality () = (* Every day of 2026 yields an office without raising. Not a slug @@ -444,8 +463,8 @@ let suite_extra = 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; - Alcotest.test_case "anchors cover easter-derived named days" `Quick - test_anchors_cover_easter_derived_named_days; + Alcotest.test_case "anchors cover all named days" `Quick + test_anchors_cover_all_named_days; Alcotest.test_case "anchors erosion is caught" `Quick test_anchors_erosion_is_caught ] let suite = |