diff options
| -rw-r--r-- | lib/rites/rite_ef/temporal_ef.ml | 22 | ||||
| -rw-r--r-- | test/test_temporal_ef.ml | 29 |
2 files changed, 47 insertions, 4 deletions
diff --git a/lib/rites/rite_ef/temporal_ef.ml b/lib/rites/rite_ef/temporal_ef.ml index 4eac99f..4147278 100644 --- a/lib/rites/rite_ef/temporal_ef.ml +++ b/lib/rites/rite_ef/temporal_ef.ml @@ -95,15 +95,31 @@ let named d = Some (Paschaltide, "ef-ascension-vigil", Colour.White, Class2, None) else if same d (off 39) then Some (Paschaltide, "ef-ascension", Colour.White, Class1, None) else if same d (off 48) then - Some (Paschaltide, "ef-pentecost-vigil", Colour.Red, Class1, None) (* RG 91 entry 9 *) - else if same d (off 49) then Some (Paschaltide, "ef-pentecost", Colour.Red, Class1, None) + (* Carries week 7 -- the same week as the Friday before it -- for + consistency with the other named Sundays here (Easter, Low Sunday, + Trinity below): a named day inside a season run must not interrupt the + run's week continuity. Not an RG rule, an internal-consistency one; + this was [None] until the Validate invariant harness (Task 14) caught + the resulting jump on the following Monday. *) + Some (Paschaltide, "ef-pentecost-vigil", Colour.Red, Class1, Some 7) (* RG 91 entry 9 *) + else if same d (off 49) then + (* Carries week 8, for the same reason as the Vigil just above. *) + Some (Paschaltide, "ef-pentecost", Colour.Red, Class1, Some 8) else if same d (off 56) then Some (Time_after_pentecost, "ef-trinity", Colour.White, Class1, Some 1) else if same d (off 60) then Some (Time_after_pentecost, "ef-corpus-christi", Colour.White, Class1, None) else if same d (off 68) then Some (Time_after_pentecost, "ef-sacred-heart", Colour.White, Class1, None) else if same d (christ_the_king y) then - Some (Time_after_pentecost, "ef-christ-the-king", Colour.White, Class1, None) + (* Carries its computed week number too, for the same internal-consistency + reason as Pentecost above -- caught by the same Validate finding. + Unlike Pentecost this isn't a fixed Easter-offset, so it can't be a + literal; [week] below computes it but is defined later in this file and + can't be called from here, so the same expression is inlined here. + test_named_week_agrees_with_week pins the two together. *) + let pentecost = off 49 in + Some (Time_after_pentecost, "ef-christ-the-king", Colour.White, Class1, + Some ((Date.to_rata d - Date.to_rata pentecost) / 7)) else None let days_between a b = Date.to_rata b - Date.to_rata a diff --git a/test/test_temporal_ef.ml b/test/test_temporal_ef.ml index aa84014..f99626c 100644 --- a/test/test_temporal_ef.ml +++ b/test/test_temporal_ef.ml @@ -162,6 +162,32 @@ 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 = + QCheck.Test.make ~count:200 + ~name:"named's explicit week agrees with week, wherever named gives one" + (QCheck.int_range 1583 9998) + (fun y -> + let start = d y 1 1 in + let stop = d (y + 1) 1 1 in + let n = D.to_rata stop - D.to_rata start in + let rec check i = + 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) + in + check 0) + module Cel = Colitur_kernel.Celebration module Sl = Colitur_kernel.Slug module Colr = Colitur_kernel.Colour @@ -277,4 +303,5 @@ let suite = ( "Rite_ef", [ Alcotest.test_case "vocab roundtrips" `Quick test_vocab_roundtrips; Alcotest.test_case "slug words" `Quick test_slug_words ] - @ suite_extra ) + @ suite_extra + @ List.map QCheck_alcotest.to_alcotest [ prop_named_week_agrees_with_week ] ) |