module D = Colitur_kernel.Date let mk y m d = match D.make ~year:y ~month:m ~day:d with | Ok t -> t | Error e -> Alcotest.failf "make %04d-%02d-%02d: %s" y m d e let wd_str = function | D.Sun -> "Sun" | D.Mon -> "Mon" | D.Tue -> "Tue" | D.Wed -> "Wed" | D.Thu -> "Thu" | D.Fri -> "Fri" | D.Sat -> "Sat" let ymd d = (D.year d, D.month d, D.day d) let test_weekday () = Alcotest.(check string) "1970-01-01 is Thursday" "Thu" (wd_str (D.weekday (mk 1970 1 1))); Alcotest.(check string) "2026-07-31 is Friday" "Fri" (wd_str (D.weekday (mk 2026 7 31))) let test_roundtrip () = let d = mk 2026 7 31 in Alcotest.(check int) "of_rata(to_rata d) = d" 0 (D.compare (D.of_rata (D.to_rata d)) d) let test_add_days () = Alcotest.(check (triple int int int)) "2024-02-28 +1 = 2024-02-29" (2024, 2, 29) (ymd (D.add_days (mk 2024 2 28) 1)); Alcotest.(check (triple int int int)) "2023-02-28 +1 = 2023-03-01" (2023, 3, 1) (ymd (D.add_days (mk 2023 2 28) 1)) let test_make_reject () = Alcotest.(check bool) "reject 2026-02-30" true (Result.is_error (D.make ~year:2026 ~month:2 ~day:30)); Alcotest.(check bool) "reject year 1000" true (Result.is_error (D.make ~year:1000 ~month:1 ~day:1)) (* ---- properties (year-independent, the confidence-to-9999 core) ---- *) let arb_date = let open QCheck in map (fun (y, off) -> let jan1 = match D.make ~year:y ~month:1 ~day:1 with Ok t -> t | Error e -> failwith e in D.of_rata (D.to_rata jan1 + off)) (pair (int_range 1583 9999) (int_range 0 364)) let prop_roundtrip = QCheck.Test.make ~name:"of_rata . to_rata = id" arb_date (fun d -> D.compare (D.of_rata (D.to_rata d)) d = 0) let prop_add_inverse = QCheck.Test.make ~name:"add_days n then -n = id" QCheck.(pair arb_date (int_range (-4000) 4000)) (fun (d, n) -> D.compare (D.add_days (D.add_days d n) (-n)) d = 0) let prop_weekday_cycle = QCheck.Test.make ~name:"weekday(add_days d 7) = weekday d" arb_date (fun d -> D.weekday (D.add_days d 7) = D.weekday d) let test_iso8601 () = Alcotest.(check string) "to_iso8601" "2026-04-05" (D.to_iso8601 (mk 2026 4 5)); (match D.of_iso8601 "2026-04-05" with | Ok d -> Alcotest.(check int) "of_iso8601 roundtrip" 0 (D.compare d (mk 2026 4 5)) | Error e -> Alcotest.failf "of_iso8601: %s" e); Alcotest.(check bool) "reject garbage" true (Result.is_error (D.of_iso8601 "nope")); Alcotest.(check bool) "reject 2026-02-30" true (Result.is_error (D.of_iso8601 "2026-02-30")) let test_date_sexp () = let d = mk 2026 4 5 in Alcotest.(check string) "sexp_of_t" "2026-04-05" (Sexplib.Sexp.to_string (D.sexp_of_t d)); Alcotest.(check int) "t_of_sexp roundtrip" 0 (D.compare (D.t_of_sexp (D.sexp_of_t d)) d); Alcotest.(check string) "weekday_to_string" "sunday" (D.weekday_to_string (D.weekday d)) let suite = ( "Date", [ Alcotest.test_case "weekday" `Quick test_weekday; Alcotest.test_case "roundtrip" `Quick test_roundtrip; Alcotest.test_case "add_days boundaries" `Quick test_add_days; Alcotest.test_case "make rejects invalid" `Quick test_make_reject; Alcotest.test_case "iso8601" `Quick test_iso8601; Alcotest.test_case "sexp" `Quick test_date_sexp ] @ List.map QCheck_alcotest.to_alcotest [ prop_roundtrip; prop_add_inverse; prop_weekday_cycle ] )