summaryrefslogtreecommitdiff
path: root/test/test_validate.ml
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-11 16:23:27 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-11 16:23:27 +0200
commit23892f0a5933851e90fb8b6aef5c3b6f7e24bc1b (patch)
treed1c0cc11678bc43ad3fee19273334e3f32adb72f /test/test_validate.ml
parent68cff511cd79ca5450c4f21dffba1b1e4ac93389 (diff)
downloadcolitur-23892f0a5933851e90fb8b6aef5c3b6f7e24bc1b.tar.gz
colitur-23892f0a5933851e90fb8b6aef5c3b6f7e24bc1b.zip
kernel(validate): never raise at 9999; add anchor, determinism, vocab checks
Validate.run ~year:9999 raised (year_start (year + 1) asked year_start for civil year 10000, out of the kernel's 1583..9999 domain), even though 9999 is itself in range and kernel computation must never raise on in-range input; ~year:9998 already returned zero failures. run now clamps its scan to 31 December 9999 instead of computing year_start (year + 1) when year is the domain maximum, and validates the resulting truncated final liturgical year rather than not being able to run it at all. The design spec's validation §5 lists eight checks; only five were implemented (coverage, seasons, weeks, weekday, closure). The two missing were a real gap, not just a documentation slip: - §5.7 anchor agreement. All of an EF year's Easter-derived and fixed named days were pinned only by point assertions for 2026. run now takes an ~anchors:(int -> (string * Date.t) list) parameter -- the rite's own independent restatement of those dates, paired with the slug each should carry, not derived from temporal itself -- and checks that temporal agrees on every one of them. Temporal_ef.anchors supplies EF's list. Kept rite-agnostic: the anchor list comes from the rite argument, not the kernel. - §5.8 determinism. run now calls temporal a second time for every date and checks the result is structurally equal to the first. Also, finding 8: the rank/season closure checks compare vocab entries via their _to_string images, which is only sound if those images are injective. run now checks List.map rank_to_string ranks and List.map season_to_string seasons for duplicates up front and reports a "vocab" failure if either collapses two distinct values to the same string, rather than relying on that injectivity unasserted. Test-quality fixes to the existing synthetic fixture, found while adding coverage for the above: the fixture's own comment claimed its mutation target (2026-03-15) was "not a Sunday" and "sits safely mid-run" -- it is a Sunday, which made the coverage/week mutations cascade further than documented even though the assertions still target specific check labels. Moved to a genuine mid-week day (2026-03-17) and the comment corrected. extreme_years's own test required only "found at least one" of the two Easter-extreme years; tightened to require both, since both genuinely exist in 1583..2500. Covering tests: test_year_9999_does_not_raise (would error under the old code; the fix is pinned by calling run 9999 directly with no try, plus asserting the truncated year is reported via an ordinary "seasons" failure, not silently or via coverage); anchor-clean and anchor-fires cases on the synthetic rite; a determinism-fires case using a target date whose temporal alternates what it returns across successive calls; two vocab-injectivity-fires cases (collapsed rank strings, collapsed season strings).
Diffstat (limited to 'test/test_validate.ml')
-rw-r--r--test/test_validate.ml101
1 files changed, 93 insertions, 8 deletions
diff --git a/test/test_validate.ml b/test/test_validate.ml
index a2478f7..c19957d 100644
--- a/test/test_validate.ml
+++ b/test/test_validate.ml
@@ -3,7 +3,7 @@ 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 ~year
+ Val.run V.vocab ~year_start:T.year_start ~temporal:T.temporal ~anchors:T.anchors ~year
let check_year year =
match run year with
@@ -14,6 +14,23 @@ let check_year year =
let test_landmark_years () = List.iter check_year [ 1583; 2026; 2035; 9998 ]
+(* Register finding 2 / controller finding B: [Validate.run ~year:9999] used
+ to raise ([year_start (year + 1)] asks for civil year 10000, out of the
+ kernel's domain), even though 9999 is in range and kernel computation must
+ never raise on in-range input. [run] now clamps its scan to 31 Dec 9999
+ instead. Calling [run 9999] directly (no [try]) is itself part of the
+ pin: if the clamp regressed, this call would raise and the test would
+ error. The clamped scan only covers Advent and the start of Christmastide,
+ so it is *expected* to report the season run as incomplete -- this pins
+ that the incompleteness surfaces as an ordinary "seasons" failure, not an
+ uncaught exception, and that nothing else broke in the process. *)
+let test_year_9999_does_not_raise () =
+ let fs = run 9999 in
+ Alcotest.(check bool) "no coverage failures (temporal stayed total through the clamp)" true
+ (not (List.exists (fun f -> f.Val.check = "coverage") fs));
+ Alcotest.(check bool) "seasons check flags the truncated final year as incomplete" true
+ (List.exists (fun f -> f.Val.check = "seasons") fs)
+
(* Easter extremes: the earliest possible date is 22 March and the latest is
25 April. Find one of each inside the domain and validate those years. *)
let extreme_years () =
@@ -29,7 +46,10 @@ let extreme_years () =
let test_easter_extremes () =
let ys = extreme_years () in
- Alcotest.(check bool) "found at least one extreme year" true (ys <> []);
+ (* Both extremes genuinely occur in 1583..2500 (earliest 1818, latest
+ 2038); requiring just "non-empty" would have passed even if the search
+ silently found only one of them (register finding 15). *)
+ Alcotest.(check int) "found both extreme years (earliest 22 Mar and latest 25 Apr)" 2 (List.length ys);
List.iter check_year ys
(* The confidence-to-9999 core: random years across the whole domain. *)
@@ -77,6 +97,14 @@ module Synthetic = struct
colour mutation below, where that risk is called out explicitly.) *)
let vocab_missing_rank = { vocab with Vocab.ranks = [ R1 ] }
+ (* Register finding 8: rank_to_string collapsing two distinct ranks to the
+ same string, and season_to_string doing the same -- a realistic
+ documentation/data-drift scenario distinct from [vocab_missing_rank]
+ above (that one omits a rank entirely; these make two indistinguishable
+ instead). *)
+ let vocab_collapsed_ranks = { vocab with Vocab.rank_to_string = (fun _ -> "same") }
+ let vocab_collapsed_seasons = { vocab with Vocab.season_to_string = (fun _ -> "same") }
+
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 =
@@ -108,12 +136,22 @@ module Synthetic = struct
{ 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" () }
- (* The one day each mutation below corrupts. Not a Sunday, and not New
- Year's Day or the season split, so it sits safely mid-run for every
- check that cares about run position. *)
- let target = match D.make ~year:2026 ~month:3 ~day:15 with Ok d -> d | Error e -> failwith e
+ (* The one day each mutation below corrupts. Genuinely mid-week (Tuesday,
+ not the Sunday that "2026-03-15" actually is despite the comment this
+ replaces having claimed otherwise -- register finding 12): not a
+ Sunday, and not New Year's Day or the season split, so it sits safely
+ mid-run for every check that cares about run position. *)
+ let target = match D.make ~year:2026 ~month:3 ~day:17 with Ok d -> d | Error e -> failwith e
+
+ (* Register finding 3: the rite's own independent restatement of one fixed
+ anchor -- [target]'s date, paired with the slug [good] already gives it
+ -- so the anchor-agreement check has something non-trivial to check in
+ 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 run ?(vocab = vocab) temporal = Val.run vocab ~year_start ~temporal ~year:2026
let has_check check (fs : Val.failure list) = List.exists (fun f -> f.Val.check = check) fs
end
@@ -184,9 +222,51 @@ let test_colour_fires () =
Alcotest.(check bool) "colour check fires when the colour is outside Colour.all" true
(has_check "colour" (run temporal))
+(* Register finding 3 (§5.8 determinism). [target] alternates what it
+ returns across successive calls with the same date -- everything else is
+ [good], genuinely pure -- so the first call (feeding the season/week/etc.
+ checks) and [run]'s own repeated call (the determinism check itself) see
+ different results for that one date. *)
+let test_determinism_fires () =
+ let calls = ref 0 in
+ let temporal d =
+ if D.compare d target = 0 then begin
+ incr calls;
+ let t = good d in
+ if !calls mod 2 = 0 then { t with Temporal.week = Some 999 } else t
+ end
+ else good d
+ in
+ Alcotest.(check bool) "determinism check fires when a repeated call returns a different result" true
+ (has_check "determinism" (run temporal))
+
+(* Register finding 3 (§5.7 anchor agreement). *)
+let test_anchor_clean () =
+ Alcotest.(check bool) "the rite's own anchor list agrees with its own temporal, so no anchor failures"
+ true (not (has_check "anchor" (run ~anchors good)))
+
+let test_anchor_fires () =
+ let temporal d =
+ let t = good d in
+ if D.compare d target = 0 then
+ { t with Temporal.office = { t.Temporal.office with Cel.slug = Slug.of_string_exn "syn-wrong-anchor" } }
+ else t
+ in
+ Alcotest.(check bool) "anchor check fires when temporal disagrees with the rite's own anchor list" true
+ (has_check "anchor" (run ~anchors temporal))
+
+let test_vocab_rank_injectivity_fires () =
+ Alcotest.(check bool) "vocab check fires when rank_to_string collapses two ranks to one string" true
+ (has_check "vocab" (run ~vocab:vocab_collapsed_ranks good))
+
+let test_vocab_season_injectivity_fires () =
+ Alcotest.(check bool) "vocab check fires when season_to_string collapses two seasons to one string" true
+ (has_check "vocab" (run ~vocab:vocab_collapsed_seasons good))
+
let suite =
( "Validate",
[ Alcotest.test_case "landmark years" `Quick test_landmark_years;
+ 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 "coverage fires" `Quick test_coverage_fires;
@@ -194,5 +274,10 @@ let suite =
Alcotest.test_case "week fires" `Quick test_week_fires;
Alcotest.test_case "weekday fires" `Quick test_weekday_fires;
Alcotest.test_case "rank fires" `Quick test_rank_fires;
- Alcotest.test_case "colour fires" `Quick test_colour_fires ]
+ Alcotest.test_case "colour fires" `Quick test_colour_fires;
+ Alcotest.test_case "determinism fires" `Quick test_determinism_fires;
+ Alcotest.test_case "anchor clean" `Quick test_anchor_clean;
+ Alcotest.test_case "anchor fires" `Quick test_anchor_fires;
+ Alcotest.test_case "vocab rank injectivity fires" `Quick test_vocab_rank_injectivity_fires;
+ Alcotest.test_case "vocab season injectivity fires" `Quick test_vocab_season_injectivity_fires ]
@ List.map QCheck_alcotest.to_alcotest [ prop_invariants ] )