aboutsummaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/test_colitur.ml7
-rw-r--r--test/test_date.ml62
2 files changed, 64 insertions, 5 deletions
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index 7fc5239..734257c 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -1,5 +1,2 @@
-(* Aggregating test runner. Per-module suites (Test_date, Test_computus) are added
- in Tasks 1-2; for now the scaffold proves the harness builds and runs. *)
-let () =
- Alcotest.run "colitur"
- [ ("scaffold", [ Alcotest.test_case "harness builds" `Quick (fun () -> ()) ]) ]
+(* Aggregating test runner. Per-module suites live in test_<module>.ml. *)
+let () = Alcotest.run "colitur" [ Test_date.suite ]
diff --git a/test/test_date.ml b/test/test_date.ml
new file mode 100644
index 0000000..2458659
--- /dev/null
+++ b/test/test_date.ml
@@ -0,0 +1,62 @@
+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 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 ]
+ @ List.map QCheck_alcotest.to_alcotest
+ [ prop_roundtrip; prop_add_inverse; prop_weekday_cycle ] )