diff options
| author | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-07-31 14:04:22 +0200 |
|---|---|---|
| committer | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-07-31 14:04:22 +0200 |
| commit | cdb7ffe804ca19aee935af090f76c9eb83cbce14 (patch) | |
| tree | 68dcf9989d7e394866bcfe3e62ae6c3075339b35 /test/test_date.ml | |
| parent | e94eeaa19627a9a0f235baf110780c9fb564ca2b (diff) | |
| download | colitur-cdb7ffe804ca19aee935af090f76c9eb83cbce14.tar.gz colitur-cdb7ffe804ca19aee935af090f76c9eb83cbce14.zip | |
kernel(date): proleptic Gregorian date, validated make + arithmetic
Hinnant civil<->days rep (1970-epoch rata die); make validates month/day and
the 1583..9999 domain; of_rata/add_days are total arithmetic. Weekday, compare.
Tested: known weekdays, leap boundaries, rejects; qcheck round-trip / add-inverse
/ weekday-cycle properties over random in-range dates.
Diffstat (limited to 'test/test_date.ml')
| -rw-r--r-- | test/test_date.ml | 62 |
1 files changed, 62 insertions, 0 deletions
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 ] ) |
