diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/cli.t | 4 | ||||
| -rw-r--r-- | test/test_temporal_ef.ml | 139 |
2 files changed, 107 insertions, 36 deletions
@@ -24,8 +24,8 @@ The EF temporal cycle for a year, one line per day: $ colitur temporal 2026 | head -3 2026-01-01 thursday christmastide ef-circumcision class-1 white - 2026-01-02 friday christmastide ef-christmas-0-friday class-4 white - 2026-01-03 saturday christmastide ef-christmas-0-saturday class-4 white + 2026-01-02 friday christmastide ef-christmas-1-friday class-4 white + 2026-01-03 saturday christmastide ef-christmas-1-saturday class-4 white $ colitur temporal 2026 | wc -l 365 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 -> "<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 ] ) |