aboutsummaryrefslogtreecommitdiff
path: root/test/test_names.ml
diff options
context:
space:
mode:
Diffstat (limited to 'test/test_names.ml')
-rw-r--r--test/test_names.ml137
1 files changed, 133 insertions, 4 deletions
diff --git a/test/test_names.ml b/test/test_names.ml
index cef7357..f3cdc54 100644
--- a/test/test_names.ml
+++ b/test/test_names.ml
@@ -2,6 +2,11 @@ module N = Colitur_kernel.Names
module L = Colitur_kernel.Lang
module C = Colitur_kernel.Citation
module DS = Colitur_kernel.Date_spec
+
+(* Task: Date_spec.resolve now takes the rite's own Easter (movable specs).
+ These fixtures are all [Fixed], so the value is irrelevant to them -- but it
+ must be supplied, and the Gregorian one is the honest choice here. *)
+let easter_of y = Colitur_kernel.Computus.gregorian_easter y
module D = Colitur_kernel.Date
let lang s = L.of_string_exn s
@@ -52,15 +57,15 @@ let test_citation () =
let test_date_spec () =
(match DS.fixed ~month:3 ~day:25 with
| Ok ds -> (
- match DS.resolve ds ~year:2026 with
+ match DS.resolve ds ~year:2026 ~easter:(easter_of 2026) with
| Some d -> Alcotest.(check string) "resolve" "2026-03-25" (D.to_iso8601 d)
| None -> Alcotest.fail "resolve returned None")
| Error e -> Alcotest.failf "fixed: %s" e);
(* Feb 29 is a legitimate fixed date that simply does not occur every year. *)
(match DS.fixed ~month:2 ~day:29 with
| Ok ds ->
- Alcotest.(check bool) "Feb 29 resolves in 2024" true (DS.resolve ds ~year:2024 <> None);
- Alcotest.(check bool) "Feb 29 absent in 2026" true (DS.resolve ds ~year:2026 = None)
+ Alcotest.(check bool) "Feb 29 resolves in 2024" true (DS.resolve ds ~year:2024 ~easter:(easter_of 2024) <> None);
+ Alcotest.(check bool) "Feb 29 absent in 2026" true (DS.resolve ds ~year:2026 ~easter:(easter_of 2026) = None)
| Error e -> Alcotest.failf "Feb 29 must be constructible: %s" e);
Alcotest.(check bool) "reject Feb 30" true (Result.is_error (DS.fixed ~month:2 ~day:30));
Alcotest.(check bool) "reject Apr 31" true (Result.is_error (DS.fixed ~month:4 ~day:31));
@@ -176,6 +181,118 @@ let test_record () =
[ "2026-04-05"; "ef"; "ordinary"; "1"; "sunday"; "ef-easter-sunday"; "high"; "white"; "lord" ]
(Rec.to_row r)
+
+(* ---- movable Date_spec variants (2026-08-17) ----
+ Every date literal below was checked against `date -d` before being typed,
+ the same rule test_golden.ml states for itself. Easter 2026 is 5 April. *)
+
+let easter_2026 = easter_of 2026
+
+let test_easter_offset_resolves () =
+ let ds = match DS.easter_offset 38 with Ok d -> d | Error e -> failwith e in
+ (* Easter 2026 = 5 April; +38 = 13 May, the Wednesday before Ascension --
+ the offset Rogation Wednesday needs (RG 87). *)
+ Alcotest.(check string) "Easter+38 in 2026" "2026-05-13"
+ (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none")
+
+let test_easter_offset_zero_is_easter () =
+ let ds = match DS.easter_offset 0 with Ok d -> d | Error e -> failwith e in
+ Alcotest.(check string) "Easter+0 is Easter itself" "2026-04-05"
+ (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none")
+
+let test_easter_offset_negative () =
+ let ds = match DS.easter_offset (-46) with Ok d -> d | Error e -> failwith e in
+ (* Ash Wednesday 2026 is 18 February, Easter-46. *)
+ Alcotest.(check string) "Easter-46 is Ash Wednesday" "2026-02-18"
+ (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none")
+
+let test_nth_weekday_first_sunday_october () =
+ let ds = match DS.nth_weekday ~month:10 ~nth:1 ~weekday:D.Sun with Ok d -> d | Error e -> failwith e in
+ (* 1 October 2026 is a Thursday, so the first Sunday is the 4th. *)
+ Alcotest.(check string) "first Sunday of October 2026" "2026-10-04"
+ (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none")
+
+let test_nth_weekday_last_sunday_october () =
+ let ds = match DS.nth_weekday ~month:10 ~nth:(-1) ~weekday:D.Sun with Ok d -> d | Error e -> failwith e in
+ Alcotest.(check string) "last Sunday of October 2026" "2026-10-25"
+ (match DS.resolve ds ~year:2026 ~easter:easter_2026 with Some d -> D.to_iso8601 d | None -> "none")
+
+let test_nth_weekday_absent_fifth () =
+ let ds = match DS.nth_weekday ~month:10 ~nth:5 ~weekday:D.Sun with Ok d -> d | Error e -> failwith e in
+ (* October 2026 has four Sundays (4, 11, 18, 25). A fifth is not an error --
+ it simply does not occur, the same contract 29 February has. *)
+ Alcotest.(check bool) "a fifth Sunday the month lacks resolves to None" true
+ (DS.resolve ds ~year:2026 ~easter:easter_2026 = None)
+
+let test_nth_weekday_february_leap_edge () =
+ let ds = match DS.nth_weekday ~month:2 ~nth:(-1) ~weekday:D.Sat with Ok d -> d | Error e -> failwith e in
+ (* 2024 is a leap year; 29 February is a Thursday, so the last Saturday is
+ the 24th. Exercises the month-length probe against Date.make rather than
+ a duplicated leap rule. *)
+ Alcotest.(check string) "last Saturday of February 2024" "2024-02-24"
+ (match DS.resolve ds ~year:2024 ~easter:(easter_of 2024) with Some d -> D.to_iso8601 d | None -> "none")
+
+let test_movable_constructors_reject_nonsense () =
+ Alcotest.(check bool) "nth = 0 rejected" true (Result.is_error (DS.nth_weekday ~month:10 ~nth:0 ~weekday:D.Sun));
+ Alcotest.(check bool) "nth = 6 rejected" true (Result.is_error (DS.nth_weekday ~month:10 ~nth:6 ~weekday:D.Sun));
+ Alcotest.(check bool) "nth = -6 rejected" true (Result.is_error (DS.nth_weekday ~month:10 ~nth:(-6) ~weekday:D.Sun));
+ Alcotest.(check bool) "month 13 rejected" true (Result.is_error (DS.nth_weekday ~month:13 ~nth:1 ~weekday:D.Sun));
+ Alcotest.(check bool) "offset 400 rejected" true (Result.is_error (DS.easter_offset 400));
+ Alcotest.(check bool) "offset -400 rejected" true (Result.is_error (DS.easter_offset (-400)))
+
+(* The failure this guards is INVISIBLE: an unvalidated spec deserialises into
+ something that silently never resolves, and a celebration vanishes with no
+ diagnostic anywhere. Date_spec quarantines the derived parser in [Repr] and
+ re-validates in a hand-written [t_of_sexp] for exactly that reason; the two
+ new variants are held to it too, or the guarantee is only partial. *)
+let test_movable_sexp_parser_rejects_invalid () =
+ List.iter
+ (fun s ->
+ Alcotest.(check bool)
+ (Printf.sprintf "rejects %s" s)
+ true
+ (try
+ ignore (DS.t_of_sexp (Sexplib.Sexp.of_string s));
+ false
+ with _ -> true))
+ [ "(Nth_weekday (month 10) (nth 0) (weekday Sun))";
+ "(Nth_weekday (month 13) (nth 1) (weekday Sun))";
+ "(Nth_weekday (month 10) (nth 9) (weekday Sun))";
+ "(Easter_offset 100000)";
+ "(Easter_offset -100000)" ]
+
+let test_movable_sexp_roundtrip () =
+ List.iter
+ (fun ds -> Alcotest.(check bool) "sexp round-trips" true (DS.t_of_sexp (DS.sexp_of_t ds) = ds))
+ [ (match DS.fixed ~month:6 ~day:30 with Ok d -> d | Error e -> failwith e);
+ (match DS.easter_offset 38 with Ok d -> d | Error e -> failwith e);
+ (match DS.easter_offset (-63) with Ok d -> d | Error e -> failwith e);
+ (match DS.nth_weekday ~month:10 ~nth:1 ~weekday:D.Sun with Ok d -> d | Error e -> failwith e);
+ (match DS.nth_weekday ~month:10 ~nth:(-1) ~weekday:D.Sat with Ok d -> d | Error e -> failwith e) ]
+
+(* Year-independent properties: the confidence-past-2050 mechanism. *)
+let prop_nth_weekday_lands_correctly =
+ QCheck.Test.make ~count:500 ~name:"Nth_weekday resolves into its own month with its own weekday"
+ QCheck.(triple (int_range 1583 9998) (int_range 1 12) (int_range 1 5))
+ (fun (year, month, nth) ->
+ match DS.nth_weekday ~month ~nth ~weekday:D.Sun with
+ | Error _ -> false
+ | Ok ds -> (
+ match DS.resolve ds ~year ~easter:(easter_of year) with
+ | None -> true (* a 5th Sunday the month lacks: legitimate *)
+ | Some d -> D.month d = month && D.weekday d = D.Sun))
+
+let prop_easter_offset_is_exactly_that_offset =
+ QCheck.Test.make ~count:500 ~name:"Easter_offset n resolves exactly n days from Easter"
+ QCheck.(pair (int_range 1600 9900) (int_range (-60) 200))
+ (fun (year, n) ->
+ match DS.easter_offset n with
+ | Error _ -> false
+ | Ok ds -> (
+ match DS.resolve ds ~year ~easter:(easter_of year) with
+ | None -> false
+ | Some d -> D.to_rata d - D.to_rata (easter_of year) = n))
+
let suite =
( "Names/Citation/DateSpec",
[ Alcotest.test_case "names basics" `Quick test_names_basics;
@@ -187,6 +304,18 @@ let suite =
Alcotest.test_case "date_spec" `Quick test_date_spec;
Alcotest.test_case "date_spec sexp roundtrip" `Quick test_date_spec_sexp_roundtrip;
Alcotest.test_case "date_spec sexp validates" `Quick test_date_spec_sexp_validates;
+ Alcotest.test_case "Easter_offset resolves" `Quick test_easter_offset_resolves;
+ Alcotest.test_case "Easter_offset 0 is Easter" `Quick test_easter_offset_zero_is_easter;
+ Alcotest.test_case "Easter_offset negative" `Quick test_easter_offset_negative;
+ Alcotest.test_case "Nth_weekday first Sunday" `Quick test_nth_weekday_first_sunday_october;
+ Alcotest.test_case "Nth_weekday last Sunday" `Quick test_nth_weekday_last_sunday_october;
+ Alcotest.test_case "Nth_weekday absent fifth" `Quick test_nth_weekday_absent_fifth;
+ Alcotest.test_case "Nth_weekday February leap edge" `Quick test_nth_weekday_february_leap_edge;
+ Alcotest.test_case "movable constructors reject nonsense" `Quick test_movable_constructors_reject_nonsense;
+ Alcotest.test_case "movable sexp parser rejects invalid" `Quick test_movable_sexp_parser_rejects_invalid;
+ Alcotest.test_case "movable sexp roundtrip" `Quick test_movable_sexp_roundtrip;
Alcotest.test_case "celebration" `Quick test_celebration;
Alcotest.test_case "celebration status" `Quick test_celebration_status;
- Alcotest.test_case "record" `Quick test_record ] )
+ Alcotest.test_case "record" `Quick test_record ]
+ @ List.map QCheck_alcotest.to_alcotest
+ [ prop_nth_weekday_lands_correctly; prop_easter_offset_is_exactly_that_offset ] )
generated by cgit v1.3 (git 2.53.0) at 2026-09-19 11:13:51 +0000