From 6436509d6b599b7d7c6467bd39c8090cb9634889 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 19:39:37 +0200 Subject: kernel(rite): bundle what a rite supplies; make season runs rite-supplied Validate took four loose arguments that had to come from the same rite with nothing enforcing it, and Calendar is about to add more. Bundling makes a mismatched assembly unrepresentable through the normal path. season_runs replaces the hardcoded assumption that every season occupies exactly one unbroken run. That holds for the 1962 rite but is false for the modern form's Ordinary Time, which is one season in two runs -- as written the check would have reported a false failure every year for the second rite. --- test/test_validate.ml | 79 +++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 73 insertions(+), 6 deletions(-) (limited to 'test') diff --git a/test/test_validate.ml b/test/test_validate.ml index c19957d..31d7a3d 100644 --- a/test/test_validate.ml +++ b/test/test_validate.ml @@ -1,9 +1,23 @@ module Val = Colitur_kernel.Validate +module Rite = Colitur_kernel.Rite +module P = Colitur_kernel.Precedence module V = Rite_ef.Vocab_ef module T = Rite_ef.Temporal_ef -let run year = - Val.run V.vocab ~year_start:T.year_start ~temporal:T.temporal ~anchors:T.anchors ~year +(* Plan 3's real EF precedence rules (Precedence_ef, Tasks 7-11) don't exist + yet -- Validate.run doesn't read [rules] at all (nothing does before + Task 5's Calendar), so a placeholder is enough to assemble a well-typed + Rite.t here. *) +let ef_rules : (V.season, V.rank) P.rules = + { P.band = (fun _ _ -> 0); + disposition = (fun ~winner:_ ~loser:_ -> P.Omit); + admit = (fun ~observed:_ _ -> []) } + +let ef_rite : (V.season, V.rank) Rite.t = + { Rite.id = T.id; vocab = V.vocab; year_start = T.year_start; temporal = T.temporal; + anchors = T.anchors; rules = ef_rules; season_runs = V.seasons } + +let run year = Val.run ef_rite ~year let check_year year = match run year with @@ -77,6 +91,8 @@ module Synthetic = struct module Slug = Colitur_kernel.Slug module Colour = Colitur_kernel.Colour module Temporal = Colitur_kernel.Temporal + module P = Colitur_kernel.Precedence + module Rite = Colitur_kernel.Rite type season = A | B type rank = R1 | R2 @@ -105,6 +121,13 @@ module Synthetic = struct let vocab_collapsed_ranks = { vocab with Vocab.rank_to_string = (fun _ -> "same") } let vocab_collapsed_seasons = { vocab with Vocab.season_to_string = (fun _ -> "same") } + (* Precedence_ef doesn't exist yet (Tasks 7-11); Validate.run never reads + [rules], so a placeholder is enough to assemble a well-typed Rite.t. *) + let rules : (season, rank) P.rules = + { P.band = (fun _ _ -> 0); + disposition = (fun ~winner:_ ~loser:_ -> P.Omit); + admit = (fun ~observed:_ _ -> []) } + let year_start y = match D.make ~year:y ~month:1 ~day:1 with Ok d -> d | Error e -> failwith e let weekday_index d = @@ -149,10 +172,41 @@ module Synthetic = struct this synthetic rite too, not only in EF. *) let anchors _y = [ (Slug.to_string (good target).Temporal.office.Cel.slug, target) ] - let run ?(vocab = vocab) ?(anchors = fun _ -> []) temporal = - Val.run vocab ~year_start ~temporal ~anchors ~year:2026 + let rite ?(vocab = vocab) ?(anchors = fun _ -> []) ?(season_runs = [ A; B ]) temporal + : (season, rank) Rite.t = + { Rite.id = "synthetic"; vocab; year_start; temporal; anchors; rules; season_runs } + + let run ?vocab ?anchors ?season_runs temporal = + Val.run (rite ?vocab ?anchors ?season_runs temporal) ~year:2026 let has_check check (fs : Val.failure list) = List.exists (fun f -> f.Val.check = check) fs + + (* A rite whose season B legitimately appears in two separate runs: the + civil year is split into calendar quarters, seasons alternating A B A B + -- as the modern form's Ordinary Time does (January-Ash Wednesday, then + Pentecost-Advent, with Lent/Easter and Advent/Christmas between). Each + quarter gets its own Sunday-aligned week origin, exactly as [good] does + for its own two runs, so every other invariant (weekday, week + numbering, rank, colour, determinism) stays clean and only the season + check is actually exercised. *) + let quarter_start y i = + match D.make ~year:y ~month:(1 + (i * 3)) ~day:1 with Ok d -> d | Error e -> failwith e + + let quarter_index d = (D.month d - 1) / 3 + + let two_run_temporal d = + let y = D.year d in + let qi = quarter_index d in + let s = if qi mod 2 = 0 then A else B in + let origin = sunday_on_or_before (quarter_start y qi) in + let n = floor_div (D.to_rata d - D.to_rata origin) 7 + 1 in + let slug = Printf.sprintf "syn2-%s-%d" (season_to_string s) (D.to_rata d) in + let rank = if D.weekday d = D.Sun then R1 else R2 in + { Temporal.season = s; week = Some n; weekday = D.weekday d; + office = Cel.make ~slug:(Slug.of_string_exn slug) ~rank ~colour:Colour.Green ~layer:"synthetic" () } + + let rite_with_two_runs : (season, rank) Rite.t = + rite ~season_runs:[ A; B; A; B ] two_run_temporal end open Synthetic @@ -160,6 +214,18 @@ open Synthetic let test_synthetic_baseline_is_clean () = Alcotest.(check bool) "clean synthetic fixture has no failures" true (run good = []) +(* The point of this task: a rite whose season B genuinely appears in two + separate runs (quarters 0,1,2,3 give season sequence A B A B, not a single + A-then-B pair) validates clean when [season_runs] says so. Before this + task, [Validate]'s season check hardcoded "compressed = vocab.seasons" + ([A; B]) with no way to say otherwise -- against that check this fixture's + compressed sequence, [A; B; A; B], would never match and every year would + report a spurious "seasons" failure. *) +let test_two_run_season_is_accepted () = + let r = Synthetic.rite_with_two_runs in + Alcotest.(check (list string)) "no failures" [] + (List.map Val.failure_to_string (Val.run r ~year:2026)) + let test_coverage_fires () = let temporal d = if D.compare d target = 0 then failwith "boom" else good d in Alcotest.(check bool) "coverage check fires when temporal raises" true @@ -170,10 +236,10 @@ let test_seasons_fires () = let t = good d in let y = D.year d in let flip_after = match D.make ~year:y ~month:9 ~day:1 with Ok d -> d | Error e -> failwith e in - (* Season A reappears after B: breaks "each season, one unbroken run". *) + (* Season A reappears after B: breaks the expected [A; B] run sequence. *) if D.compare d flip_after >= 0 then { t with Temporal.season = A } else t in - Alcotest.(check bool) "seasons check fires when a season recurs" true + Alcotest.(check bool) "seasons check fires when a season recurs outside season_runs" true (has_check "seasons" (run temporal)) let test_week_fires () = @@ -269,6 +335,7 @@ let suite = Alcotest.test_case "year 9999 does not raise" `Quick test_year_9999_does_not_raise; Alcotest.test_case "easter extremes" `Quick test_easter_extremes; Alcotest.test_case "synthetic baseline is clean" `Quick test_synthetic_baseline_is_clean; + Alcotest.test_case "two-run season is accepted" `Quick test_two_run_season_is_accepted; Alcotest.test_case "coverage fires" `Quick test_coverage_fires; Alcotest.test_case "seasons fires" `Quick test_seasons_fires; Alcotest.test_case "week fires" `Quick test_week_fires; -- cgit v1.3