gazagnaire.org
forked from
anil.recoil.org/ocaml-tomlt
TOML 1.1 codecs for OCaml
1(* Comprehensive tests for Tomlt codecs *)
2
3open Tomlt
4
5(* Helper to encode TOML to string via writer *)
6let toml_to_string value =
7 let buf = Buffer.create 256 in
8 Tomlt_bytesrw.to_writer (Bytesrw.Bytes.Writer.of_buffer buf) value;
9 Buffer.contents buf
10
11(* ============================================================================
12 Test Helpers
13 ============================================================================ *)
14
15(* Decode a value from "value = X" TOML *)
16let check_decode_ok name codec input expected =
17 let toml = Tomlt_bytesrw.parse input in
18 let value = Toml.get "value" toml in
19 let actual = decode codec value in
20 match actual with
21 | Ok v when v = expected -> ()
22 | Ok _ -> Alcotest.failf "%s: decode returned unexpected value" name
23 | Error e ->
24 Alcotest.failf "%s: decode failed: %s" name (Toml.Error.to_string e)
25
26(* Check that decode fails *)
27let check_decode_error name codec input =
28 let toml = Tomlt_bytesrw.parse input in
29 let value = Toml.get "value" toml in
30 match decode codec value with
31 | Error _ -> ()
32 | Ok _ -> Alcotest.failf "%s: expected decode error but succeeded" name
33
34(* Decode from a table (for table codecs) *)
35let check_decode_table_ok name codec input expected =
36 let toml = Tomlt_bytesrw.parse input in
37 let value = Toml.get "value" toml in
38 let actual = decode codec value in
39 match actual with
40 | Ok v when v = expected -> ()
41 | Ok _ -> Alcotest.failf "%s: decode returned unexpected value" name
42 | Error e ->
43 Alcotest.failf "%s: decode failed: %s" name (Toml.Error.to_string e)
44
45(* Check table decode error *)
46let check_decode_table_error name codec input =
47 let toml = Tomlt_bytesrw.parse input in
48 let value = Toml.get "value" toml in
49 match decode codec value with
50 | Error _ -> ()
51 | Ok _ -> Alcotest.failf "%s: expected decode error but succeeded" name
52
53(* Roundtrip test *)
54let check_roundtrip name codec value =
55 let toml = encode codec value in
56 match decode codec toml with
57 | Ok v when v = value -> ()
58 | Ok _ -> Alcotest.failf "%s: roundtrip mismatch, got different value" name
59 | Error e ->
60 Alcotest.failf "%s: roundtrip decode failed: %s" name
61 (Toml.Error.to_string e)
62
63(* ============================================================================
64 Datetime Type Tests
65 ============================================================================ *)
66
67(* ---- Tz tests ---- *)
68
69let test_tz_utc () =
70 Alcotest.(check string) "utc to_string" "Z" (Tz.to_string Tz.utc);
71 Alcotest.(check bool) "utc equal" true (Tz.equal Tz.utc Tz.utc);
72 match Tz.of_string "Z" with
73 | Ok tz -> Alcotest.(check bool) "parse Z" true (Tz.equal tz Tz.utc)
74 | Error e -> Alcotest.failf "failed to parse Z: %s" e
75
76let test_tz_offset () =
77 let tz_pos = Tz.offset ~hours:5 ~minutes:30 in
78 Alcotest.(check string) "positive offset" "+05:30" (Tz.to_string tz_pos);
79
80 let tz_neg = Tz.offset ~hours:(-8) ~minutes:0 in
81 Alcotest.(check string) "negative offset" "-08:00" (Tz.to_string tz_neg);
82
83 let tz_zero = Tz.offset ~hours:0 ~minutes:0 in
84 Alcotest.(check string) "zero offset" "+00:00" (Tz.to_string tz_zero)
85
86let test_tz_parse () =
87 (match Tz.of_string "+05:30" with
88 | Ok tz -> Alcotest.(check string) "parse +05:30" "+05:30" (Tz.to_string tz)
89 | Error e -> Alcotest.failf "failed to parse +05:30: %s" e);
90
91 (match Tz.of_string "-08:00" with
92 | Ok tz -> Alcotest.(check string) "parse -08:00" "-08:00" (Tz.to_string tz)
93 | Error e -> Alcotest.failf "failed to parse -08:00: %s" e);
94
95 match Tz.of_string "z" with
96 | Ok tz -> Alcotest.(check bool) "parse lowercase z" true (Tz.equal tz Tz.utc)
97 | Error e -> Alcotest.failf "failed to parse z: %s" e
98
99let test_tz_compare () =
100 let tz1 = Tz.offset ~hours:5 ~minutes:0 in
101 let tz2 = Tz.offset ~hours:6 ~minutes:0 in
102 Alcotest.(check int) "compare less" (-1) (Int.compare (Tz.compare tz1 tz2) 0);
103 Alcotest.(check int) "compare greater" 1 (Int.compare (Tz.compare tz2 tz1) 0);
104 Alcotest.(check int) "compare equal" 0 (Tz.compare tz1 tz1);
105 Alcotest.(check int)
106 "utc < offset" (-1)
107 (Int.compare (Tz.compare Tz.utc tz1) 0)
108
109(* ---- Date tests ---- *)
110
111let test_date_basic () =
112 let d = Date.make ~year:2024 ~month:6 ~day:15 in
113 Alcotest.(check string) "to_string" "2024-06-15" (Date.to_string d);
114 Alcotest.(check int) "year" 2024 d.year;
115 Alcotest.(check int) "month" 6 d.month;
116 Alcotest.(check int) "day" 15 d.day
117
118let test_date_equal () =
119 let d1 = Date.make ~year:2024 ~month:6 ~day:15 in
120 let d2 = Date.make ~year:2024 ~month:6 ~day:15 in
121 let d3 = Date.make ~year:2024 ~month:6 ~day:16 in
122 Alcotest.(check bool) "equal same" true (Date.equal d1 d2);
123 Alcotest.(check bool) "not equal diff day" false (Date.equal d1 d3)
124
125let test_date_compare () =
126 let d1 = Date.make ~year:2024 ~month:6 ~day:15 in
127 let d2 = Date.make ~year:2024 ~month:6 ~day:16 in
128 let d3 = Date.make ~year:2024 ~month:7 ~day:1 in
129 let d4 = Date.make ~year:2025 ~month:1 ~day:1 in
130 Alcotest.(check int) "compare day" (-1) (Int.compare (Date.compare d1 d2) 0);
131 Alcotest.(check int) "compare month" (-1) (Int.compare (Date.compare d1 d3) 0);
132 Alcotest.(check int) "compare year" (-1) (Int.compare (Date.compare d1 d4) 0)
133
134let test_date_parse () =
135 (match Date.of_string "2024-06-15" with
136 | Ok d ->
137 Alcotest.(check int) "year" 2024 d.year;
138 Alcotest.(check int) "month" 6 d.month;
139 Alcotest.(check int) "day" 15 d.day
140 | Error e -> Alcotest.failf "parse failed: %s" e);
141
142 match Date.of_string "1979-05-27" with
143 | Ok d -> Alcotest.(check string) "roundtrip" "1979-05-27" (Date.to_string d)
144 | Error e -> Alcotest.failf "parse failed: %s" e
145
146let test_date_edge_cases () =
147 (* First day of year *)
148 let d1 = Date.make ~year:2024 ~month:1 ~day:1 in
149 Alcotest.(check string) "jan 1" "2024-01-01" (Date.to_string d1);
150
151 (* Last day of year *)
152 let d2 = Date.make ~year:2024 ~month:12 ~day:31 in
153 Alcotest.(check string) "dec 31" "2024-12-31" (Date.to_string d2);
154
155 (* Leading zeros in year *)
156 let d3 = Date.make ~year:99 ~month:1 ~day:1 in
157 Alcotest.(check string) "year 99" "0099-01-01" (Date.to_string d3)
158
159(* ---- Time tests ---- *)
160
161let test_time_basic () =
162 let t = Time.make ~hour:14 ~minute:30 ~second:45 () in
163 Alcotest.(check string) "to_string" "14:30:45" (Time.to_string t);
164 Alcotest.(check int) "hour" 14 t.hour;
165 Alcotest.(check int) "minute" 30 t.minute;
166 Alcotest.(check int) "second" 45 t.second;
167 Alcotest.(check (float 0.001)) "frac" 0.0 t.frac
168
169let test_time_fractional () =
170 let t1 = Time.make ~hour:14 ~minute:30 ~second:45 ~frac:0.123 () in
171 Alcotest.(check string) "frac 3 digits" "14:30:45.123" (Time.to_string t1);
172
173 let t2 = Time.make ~hour:0 ~minute:0 ~second:0 ~frac:0.123456789 () in
174 Alcotest.(check string)
175 "frac 9 digits" "00:00:00.123456789" (Time.to_string t2);
176
177 let t3 = Time.make ~hour:12 ~minute:0 ~second:0 ~frac:0.1 () in
178 Alcotest.(check string) "frac 1 digit" "12:00:00.1" (Time.to_string t3)
179
180let test_time_equal () =
181 let t1 = Time.make ~hour:14 ~minute:30 ~second:45 () in
182 let t2 = Time.make ~hour:14 ~minute:30 ~second:45 () in
183 let t3 = Time.make ~hour:14 ~minute:30 ~second:46 () in
184 Alcotest.(check bool) "equal same" true (Time.equal t1 t2);
185 Alcotest.(check bool) "not equal" false (Time.equal t1 t3)
186
187let test_time_compare () =
188 let t1 = Time.make ~hour:14 ~minute:30 ~second:45 () in
189 let t2 = Time.make ~hour:14 ~minute:30 ~second:46 () in
190 let t3 = Time.make ~hour:14 ~minute:31 ~second:0 () in
191 let t4 = Time.make ~hour:15 ~minute:0 ~second:0 () in
192 Alcotest.(check int)
193 "compare second" (-1)
194 (Int.compare (Time.compare t1 t2) 0);
195 Alcotest.(check int)
196 "compare minute" (-1)
197 (Int.compare (Time.compare t1 t3) 0);
198 Alcotest.(check int) "compare hour" (-1) (Int.compare (Time.compare t1 t4) 0)
199
200let test_time_parse () =
201 (match Time.of_string "14:30:45" with
202 | Ok t ->
203 Alcotest.(check int) "hour" 14 t.hour;
204 Alcotest.(check int) "minute" 30 t.minute;
205 Alcotest.(check int) "second" 45 t.second
206 | Error e -> Alcotest.failf "parse failed: %s" e);
207
208 match Time.of_string "00:00:00.123456" with
209 | Ok t -> Alcotest.(check (float 0.000001)) "frac" 0.123456 t.frac
210 | Error e -> Alcotest.failf "parse failed: %s" e
211
212let test_time_edge_cases () =
213 let t1 = Time.make ~hour:0 ~minute:0 ~second:0 () in
214 Alcotest.(check string) "midnight" "00:00:00" (Time.to_string t1);
215
216 let t2 = Time.make ~hour:23 ~minute:59 ~second:59 () in
217 Alcotest.(check string) "end of day" "23:59:59" (Time.to_string t2)
218
219(* ---- Datetime tests ---- *)
220
221let test_datetime_basic () =
222 let dt =
223 Datetime.make
224 ~date:(Date.make ~year:2024 ~month:6 ~day:15)
225 ~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
226 ~tz:Tz.utc
227 in
228 Alcotest.(check string)
229 "to_string" "2024-06-15T14:30:00Z" (Datetime.to_string dt)
230
231let test_datetime_with_offset () =
232 let dt =
233 Datetime.make
234 ~date:(Date.make ~year:2024 ~month:6 ~day:15)
235 ~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
236 ~tz:(Tz.offset ~hours:5 ~minutes:30)
237 in
238 Alcotest.(check string)
239 "with offset" "2024-06-15T14:30:00+05:30" (Datetime.to_string dt)
240
241let test_datetime_with_frac () =
242 let dt =
243 Datetime.make
244 ~date:(Date.make ~year:2024 ~month:6 ~day:15)
245 ~time:(Time.make ~hour:14 ~minute:30 ~second:0 ~frac:0.123456 ())
246 ~tz:Tz.utc
247 in
248 Alcotest.(check string)
249 "with frac" "2024-06-15T14:30:00.123456Z" (Datetime.to_string dt)
250
251let test_datetime_parse () =
252 (match Datetime.of_string "2024-06-15T14:30:00Z" with
253 | Ok dt ->
254 Alcotest.(check int) "year" 2024 dt.date.year;
255 Alcotest.(check int) "hour" 14 dt.time.hour;
256 Alcotest.(check bool) "tz" true (Tz.equal dt.tz Tz.utc)
257 | Error e -> Alcotest.failf "parse failed: %s" e);
258
259 match Datetime.of_string "1979-05-27T07:32:00-08:00" with
260 | Ok dt ->
261 Alcotest.(check int) "year" 1979 dt.date.year;
262 Alcotest.(check string) "tz" "-08:00" (Tz.to_string dt.tz)
263 | Error e -> Alcotest.failf "parse failed: %s" e
264
265let test_datetime_equal_compare () =
266 let dt1 =
267 Datetime.make
268 ~date:(Date.make ~year:2024 ~month:6 ~day:15)
269 ~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
270 ~tz:Tz.utc
271 in
272 let dt2 =
273 Datetime.make
274 ~date:(Date.make ~year:2024 ~month:6 ~day:15)
275 ~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
276 ~tz:Tz.utc
277 in
278 let dt3 =
279 Datetime.make
280 ~date:(Date.make ~year:2024 ~month:6 ~day:16)
281 ~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
282 ~tz:Tz.utc
283 in
284 Alcotest.(check bool) "equal same" true (Datetime.equal dt1 dt2);
285 Alcotest.(check bool) "not equal" false (Datetime.equal dt1 dt3);
286 Alcotest.(check int) "compare" (-1) (Int.compare (Datetime.compare dt1 dt3) 0)
287
288(* ---- Datetime_local tests ---- *)
289
290let test_datetime_local_basic () =
291 let dt =
292 Datetime_local.make
293 ~date:(Date.make ~year:2024 ~month:6 ~day:15)
294 ~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
295 in
296 Alcotest.(check string)
297 "to_string" "2024-06-15T14:30:00"
298 (Datetime_local.to_string dt)
299
300let test_datetime_local_parse () =
301 match Datetime_local.of_string "2024-06-15T14:30:00" with
302 | Ok dt ->
303 Alcotest.(check int) "year" 2024 dt.date.year;
304 Alcotest.(check int) "hour" 14 dt.time.hour
305 | Error e -> Alcotest.failf "parse failed: %s" e
306
307let test_datetime_local_equal_compare () =
308 let dt1 =
309 Datetime_local.make
310 ~date:(Date.make ~year:2024 ~month:6 ~day:15)
311 ~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
312 in
313 let dt2 =
314 Datetime_local.make
315 ~date:(Date.make ~year:2024 ~month:6 ~day:15)
316 ~time:(Time.make ~hour:14 ~minute:30 ~second:0 ())
317 in
318 Alcotest.(check bool) "equal" true (Datetime_local.equal dt1 dt2);
319 Alcotest.(check int) "compare" 0 (Datetime_local.compare dt1 dt2)
320
321(* ============================================================================
322 Base Codec Tests
323 ============================================================================ *)
324
325(* ---- Bool codec ---- *)
326
327let test_bool_codec () =
328 check_decode_ok "true" bool "value = true" true;
329 check_decode_ok "false" bool "value = false" false
330
331let test_bool_roundtrip () =
332 check_roundtrip "true roundtrip" bool true;
333 check_roundtrip "false roundtrip" bool false
334
335let test_bool_type_error () =
336 check_decode_error "string not bool" bool {|value = "true"|}
337
338(* ---- Int codec ---- *)
339
340let test_int_codec () =
341 check_decode_ok "positive" int "value = 42" 42;
342 check_decode_ok "negative" int "value = -17" (-17);
343 check_decode_ok "zero" int "value = 0" 0;
344 check_decode_ok "large" int "value = 1000000" 1000000
345
346let test_int_formats () =
347 check_decode_ok "hex" int "value = 0xDEADBEEF" 0xDEADBEEF;
348 check_decode_ok "octal" int "value = 0o755" 0o755;
349 check_decode_ok "binary" int "value = 0b11010110" 0b11010110;
350 check_decode_ok "underscore" int "value = 1_000_000" 1_000_000
351
352let test_int_roundtrip () =
353 check_roundtrip "positive" int 42;
354 check_roundtrip "negative" int (-17);
355 check_roundtrip "zero" int 0
356
357let test_int_type_error () =
358 check_decode_error "float not int" int "value = 3.14";
359 check_decode_error "string not int" int {|value = "42"|}
360
361(* ---- Int32 codec ---- *)
362
363let test_int32_codec () =
364 check_decode_ok "positive" int32 "value = 42" 42l;
365 check_decode_ok "negative" int32 "value = -17" (-17l);
366 check_decode_ok "max" int32 "value = 2147483647" Int32.max_int;
367 check_decode_ok "min" int32 "value = -2147483648" Int32.min_int
368
369let test_int32_roundtrip () =
370 check_roundtrip "positive" int32 42l;
371 check_roundtrip "max" int32 Int32.max_int;
372 check_roundtrip "min" int32 Int32.min_int
373
374(* ---- Int64 codec ---- *)
375
376let test_int64_codec () =
377 check_decode_ok "positive" int64 "value = 42" 42L;
378 check_decode_ok "large" int64 "value = 9223372036854775807" Int64.max_int;
379 check_decode_ok "large neg" int64 "value = -9223372036854775808" Int64.min_int
380
381let test_int64_roundtrip () =
382 check_roundtrip "positive" int64 42L;
383 check_roundtrip "max" int64 Int64.max_int;
384 check_roundtrip "min" int64 Int64.min_int
385
386(* ---- Float codec ---- *)
387
388let test_float_codec () =
389 check_decode_ok "positive" float "value = 3.14" 3.14;
390 check_decode_ok "negative" float "value = -2.5" (-2.5);
391 check_decode_ok "zero" float "value = 0.0" 0.0;
392 check_decode_ok "exponent" float "value = 5e+22" 5e+22;
393 check_decode_ok "neg exponent" float "value = 1e-10" 1e-10
394
395let test_float_special () =
396 check_decode_ok "inf" float "value = inf" Float.infinity;
397 check_decode_ok "neg inf" float "value = -inf" Float.neg_infinity;
398 check_decode_ok "pos inf" float "value = +inf" Float.infinity;
399 (* nan requires special handling since nan <> nan *)
400 let toml = Tomlt_bytesrw.parse "value = nan" in
401 let value = Toml.get "value" toml in
402 match decode float value with
403 | Ok f when Float.is_nan f -> ()
404 | Ok _ -> Alcotest.fail "expected nan"
405 | Error e -> Alcotest.failf "decode failed: %s" (Toml.Error.to_string e)
406
407let test_float_roundtrip () =
408 check_roundtrip "positive" float 3.14;
409 check_roundtrip "negative" float (-2.5);
410 check_roundtrip "zero" float 0.0
411
412let test_float_type_error () =
413 check_decode_error "int not float" float "value = 42";
414 check_decode_error "string not float" float {|value = "3.14"|}
415
416(* ---- Number codec ---- *)
417
418let test_number_codec () =
419 check_decode_ok "float" number "value = 3.14" 3.14;
420 check_decode_ok "int as float" number "value = 42" 42.0;
421 check_decode_ok "negative int" number "value = -17" (-17.0)
422
423let test_number_type_error () =
424 check_decode_error "string not number" number {|value = "42"|}
425
426(* ---- String codec ---- *)
427
428let test_string_codec () =
429 check_decode_ok "basic" string {|value = "hello"|} "hello";
430 check_decode_ok "empty" string {|value = ""|} "";
431 check_decode_ok "unicode" string
432 {|value = "hello \u0048\u0065\u006C\u006C\u006F"|} "hello Hello"
433
434let test_string_escapes () =
435 check_decode_ok "newline" string {|value = "line1\nline2"|} "line1\nline2";
436 check_decode_ok "tab" string {|value = "col1\tcol2"|} "col1\tcol2";
437 check_decode_ok "quote" string {|value = "say \"hello\""|} {|say "hello"|};
438 check_decode_ok "backslash" string {|value = "path\\to\\file"|}
439 "path\\to\\file"
440
441let test_string_multiline () =
442 check_decode_ok "multiline" string {|value = """
443hello
444world"""|}
445 "hello\nworld";
446 check_decode_ok "literal" string "value = 'C:\\path\\to\\file'"
447 "C:\\path\\to\\file"
448
449let test_string_roundtrip () =
450 check_roundtrip "basic" string "hello";
451 check_roundtrip "empty" string "";
452 check_roundtrip "unicode" string "Hello, \xE4\xB8\x96\xE7\x95\x8C!"
453
454let test_string_type_error () =
455 check_decode_error "int not string" string "value = 42";
456 check_decode_error "bool not string" string "value = true"
457
458(* ============================================================================
459 Ptime Codec Tests
460 ============================================================================ *)
461
462(* ---- Ptime codecs ---- *)
463
464let ptime_testable =
465 let pp fmt t = Fmt.pf fmt "%s" (Ptime.to_rfc3339 ~tz_offset_s:0 t) in
466 Alcotest.testable pp Ptime.equal
467
468let ptime_date_testable =
469 let pp fmt (y, m, d) = Fmt.pf fmt "%04d-%02d-%02d" y m d in
470 let eq (y1, m1, d1) (y2, m2, d2) = y1 = y2 && m1 = m2 && d1 = d2 in
471 Alcotest.testable pp eq
472
473let ptime_span_testable =
474 let pp fmt span = Fmt.pf fmt "%f" (Ptime.Span.to_float_s span) in
475 let eq a b =
476 Float.abs (Ptime.Span.to_float_s a -. Ptime.Span.to_float_s b) < 0.001
477 in
478 Alcotest.testable pp eq
479
480let test_ptime_codec () =
481 let input = "value = 2024-06-15T14:30:00Z" in
482 let expected =
483 match Ptime.of_date_time ((2024, 6, 15), ((14, 30, 0), 0)) with
484 | Some t -> t
485 | None -> failwith "invalid test datetime"
486 in
487 let toml = Tomlt_bytesrw.parse input in
488 let value = Toml.get "value" toml in
489 match decode (ptime ()) value with
490 | Ok v -> Alcotest.(check ptime_testable) "ptime" expected v
491 | Error e -> Alcotest.fail (Toml.Error.to_string e)
492
493let test_ptime_codec_offset () =
494 (* Test parsing datetime with offset and verify UTC conversion *)
495 let input = "value = 1979-05-27T00:32:00-07:00" in
496 (* UTC time should be 1979-05-27T07:32:00Z *)
497 let expected =
498 match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
499 | Some t -> t
500 | None -> failwith "invalid test datetime"
501 in
502 let toml = Tomlt_bytesrw.parse input in
503 let value = Toml.get "value" toml in
504 match decode (ptime ()) value with
505 | Ok v -> Alcotest.(check ptime_testable) "ptime with offset" expected v
506 | Error e -> Alcotest.fail (Toml.Error.to_string e)
507
508let test_ptime_codec_roundtrip () =
509 let original =
510 match Ptime.of_date_time ((2024, 12, 19), ((15, 30, 45), 0)) with
511 | Some t -> t
512 | None -> failwith "invalid test datetime"
513 in
514 let toml = encode (ptime ()) original in
515 match decode (ptime ()) toml with
516 | Ok v -> Alcotest.(check ptime_testable) "roundtrip" original v
517 | Error e -> Alcotest.fail (Toml.Error.to_string e)
518
519let test_ptime_codec_optional_seconds () =
520 (* TOML 1.1 allows optional seconds *)
521 let input = "value = 1979-05-27T07:32Z" in
522 let expected =
523 match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
524 | Some t -> t
525 | None -> failwith "invalid test datetime"
526 in
527 let toml = Tomlt_bytesrw.parse input in
528 let value = Toml.get "value" toml in
529 match decode (ptime ()) value with
530 | Ok v -> Alcotest.(check ptime_testable) "optional seconds" expected v
531 | Error e -> Alcotest.fail (Toml.Error.to_string e)
532
533let test_ptime_opt_codec () =
534 (* ptime_opt only accepts offset datetimes *)
535 let input = "value = 1979-05-27T07:32:00Z" in
536 let expected =
537 match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
538 | Some t -> t
539 | None -> failwith "invalid test datetime"
540 in
541 let toml = Tomlt_bytesrw.parse input in
542 let value = Toml.get "value" toml in
543 match decode (ptime_opt ()) value with
544 | Ok t -> Alcotest.(check ptime_testable) "ptime_opt" expected t
545 | Error e -> Alcotest.fail (Toml.Error.to_string e)
546
547let test_ptime_opt_rejects_local () =
548 (* ptime_opt should reject local datetime *)
549 let input = "value = 1979-05-27T07:32:00" in
550 let toml = Tomlt_bytesrw.parse input in
551 let value = Toml.get "value" toml in
552 match decode (ptime_opt ()) value with
553 | Ok _ -> Alcotest.fail "expected error for local datetime"
554 | Error _ -> ()
555
556let test_ptime_span_codec () =
557 let input = "value = 14:30:45" in
558 let expected =
559 match
560 Ptime.Span.of_float_s ((14.0 *. 3600.0) +. (30.0 *. 60.0) +. 45.0)
561 with
562 | Some s -> s
563 | None -> failwith "invalid span"
564 in
565 let toml = Tomlt_bytesrw.parse input in
566 let value = Toml.get "value" toml in
567 match decode ptime_span value with
568 | Ok span -> Alcotest.(check ptime_span_testable) "span" expected span
569 | Error e -> Alcotest.fail (Toml.Error.to_string e)
570
571let test_ptime_span_roundtrip () =
572 let original =
573 match Ptime.Span.of_float_s ((7.0 *. 3600.0) +. (32.0 *. 60.0)) with
574 | Some s -> s
575 | None -> failwith "invalid span"
576 in
577 let toml = encode ptime_span original in
578 match decode ptime_span toml with
579 | Ok v -> Alcotest.(check ptime_span_testable) "roundtrip" original v
580 | Error e -> Alcotest.fail (Toml.Error.to_string e)
581
582let test_ptime_date_codec () =
583 let input = "value = 1979-05-27" in
584 let toml = Tomlt_bytesrw.parse input in
585 let value = Toml.get "value" toml in
586 match decode ptime_date value with
587 | Ok date -> Alcotest.(check ptime_date_testable) "date" (1979, 5, 27) date
588 | Error e -> Alcotest.fail (Toml.Error.to_string e)
589
590let test_ptime_date_roundtrip () =
591 let original = (2024, 12, 19) in
592 let toml = encode ptime_date original in
593 match decode ptime_date toml with
594 | Ok v -> Alcotest.(check ptime_date_testable) "roundtrip" original v
595 | Error e -> Alcotest.fail (Toml.Error.to_string e)
596
597let test_ptime_local_datetime () =
598 (* The new ptime () codec accepts local datetime and uses provided tz *)
599 let input = "value = 1979-05-27T07:32:00" in
600 let expected =
601 match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
602 | Some t -> t
603 | None -> failwith "invalid test datetime"
604 in
605 let toml = Tomlt_bytesrw.parse input in
606 let value = Toml.get "value" toml in
607 match decode (ptime ~tz_offset_s:0 ()) value with
608 | Ok v -> Alcotest.(check ptime_testable) "local datetime" expected v
609 | Error e -> Alcotest.fail (Toml.Error.to_string e)
610
611let test_ptime_date_as_ptime () =
612 (* The new ptime () codec accepts date and assumes midnight *)
613 let input = "value = 1979-05-27" in
614 let expected =
615 match Ptime.of_date_time ((1979, 5, 27), ((0, 0, 0), 0)) with
616 | Some t -> t
617 | None -> failwith "invalid test datetime"
618 in
619 let toml = Tomlt_bytesrw.parse input in
620 let value = Toml.get "value" toml in
621 match decode (ptime ~tz_offset_s:0 ()) value with
622 | Ok v -> Alcotest.(check ptime_testable) "date as ptime" expected v
623 | Error e -> Alcotest.fail (Toml.Error.to_string e)
624
625(* ---- Unified ptime_full codec ---- *)
626
627let ptime_full_testable =
628 Alcotest.testable Toml.pp_ptime_datetime (fun a b ->
629 match (a, b) with
630 | `Datetime (t1, tz1), `Datetime (t2, tz2) ->
631 Ptime.equal t1 t2 && tz1 = tz2
632 | `Datetime_local t1, `Datetime_local t2 -> Ptime.equal t1 t2
633 | `Date d1, `Date d2 -> d1 = d2
634 | `Time t1, `Time t2 -> t1 = t2
635 | _ -> false)
636
637let test_ptime_full_offset () =
638 let input = "value = 1979-05-27T07:32:00Z" in
639 let toml = Tomlt_bytesrw.parse input in
640 let value = Toml.get "value" toml in
641 match decode (ptime_full ()) value with
642 | Ok (`Datetime (ptime, Some 0)) ->
643 let expected =
644 match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
645 | Some t -> t
646 | None -> failwith "invalid datetime"
647 in
648 Alcotest.(check ptime_testable) "ptime" expected ptime
649 | Ok other ->
650 Alcotest.failf "expected `Datetime, got %a" Toml.pp_ptime_datetime other
651 | Error e -> Alcotest.fail (Toml.Error.to_string e)
652
653let test_ptime_full_local_datetime () =
654 let input = "value = 1979-05-27T07:32:00" in
655 let toml = Tomlt_bytesrw.parse input in
656 let value = Toml.get "value" toml in
657 match decode (ptime_full ~tz_offset_s:0 ()) value with
658 | Ok (`Datetime_local ptime) ->
659 let expected =
660 match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
661 | Some t -> t
662 | None -> failwith "invalid datetime"
663 in
664 Alcotest.(check ptime_testable) "ptime" expected ptime
665 | Ok other ->
666 Alcotest.failf "expected `Datetime_local, got %a" Toml.pp_ptime_datetime
667 other
668 | Error e -> Alcotest.fail (Toml.Error.to_string e)
669
670let test_ptime_full_date () =
671 let input = "value = 1979-05-27" in
672 let toml = Tomlt_bytesrw.parse input in
673 let value = Toml.get "value" toml in
674 match decode (ptime_full ()) value with
675 | Ok (`Date (y, m, d)) ->
676 Alcotest.(check int) "year" 1979 y;
677 Alcotest.(check int) "month" 5 m;
678 Alcotest.(check int) "day" 27 d
679 | Ok other ->
680 Alcotest.failf "expected `Date, got %a" Toml.pp_ptime_datetime other
681 | Error e -> Alcotest.fail (Toml.Error.to_string e)
682
683let test_ptime_full_time () =
684 let input = "value = 07:32:00" in
685 let toml = Tomlt_bytesrw.parse input in
686 let value = Toml.get "value" toml in
687 match decode (ptime_full ()) value with
688 | Ok (`Time (h, m, s, ns)) ->
689 Alcotest.(check int) "hour" 7 h;
690 Alcotest.(check int) "minute" 32 m;
691 Alcotest.(check int) "second" 0 s;
692 Alcotest.(check int) "nanoseconds" 0 ns
693 | Ok other ->
694 Alcotest.failf "expected `Time, got %a" Toml.pp_ptime_datetime other
695 | Error e -> Alcotest.fail (Toml.Error.to_string e)
696
697let test_ptime_full_roundtrip () =
698 let original : Toml.ptime_datetime =
699 `Datetime
700 ( (match Ptime.of_date_time ((1979, 5, 27), ((7, 32, 0), 0)) with
701 | Some t -> t
702 | None -> failwith "invalid datetime"),
703 Some 0 )
704 in
705 let toml = encode (ptime_full ()) original in
706 match decode (ptime_full ()) toml with
707 | Ok result ->
708 Alcotest.(check ptime_full_testable) "roundtrip" original result
709 | Error e -> Alcotest.fail (Toml.Error.to_string e)
710
711(* ============================================================================
712 Combinator Tests
713 ============================================================================ *)
714
715(* ---- Map combinator ---- *)
716
717let uppercase_string =
718 map string ~dec:String.uppercase_ascii ~enc:String.lowercase_ascii
719
720let test_map_combinator () =
721 check_decode_ok "uppercase" uppercase_string {|value = "hello"|} "HELLO"
722
723let test_map_roundtrip () =
724 check_roundtrip "map roundtrip" uppercase_string "HELLO"
725
726let doubled_int = map int ~dec:(fun x -> x * 2) ~enc:(fun x -> x / 2)
727
728let test_map_int () =
729 check_decode_ok "doubled" doubled_int "value = 21" 42;
730 check_roundtrip "doubled roundtrip" doubled_int 42
731
732(* ---- Const combinator ---- *)
733
734let test_const () =
735 let c = const "default_value" in
736 check_decode_ok "const ignores input" c "value = 42" "default_value";
737 check_decode_ok "const ignores string" c {|value = "ignored"|} "default_value"
738
739(* ---- Enum combinator ---- *)
740
741type level = Debug | Info | Warn | Error
742
743let level_codec =
744 enum [ ("debug", Debug); ("info", Info); ("warn", Warn); ("error", Error) ]
745
746let test_enum () =
747 check_decode_ok "debug" level_codec {|value = "debug"|} Debug;
748 check_decode_ok "info" level_codec {|value = "info"|} Info;
749 check_decode_ok "warn" level_codec {|value = "warn"|} Warn;
750 check_decode_ok "error" level_codec {|value = "error"|} Error
751
752let test_enum_roundtrip () =
753 check_roundtrip "debug" level_codec Debug;
754 check_roundtrip "error" level_codec Error
755
756let test_enum_unknown () =
757 check_decode_error "unknown value" level_codec {|value = "trace"|}
758
759let test_enum_type_error () =
760 check_decode_error "not string" level_codec "value = 42"
761
762(* ---- Option combinator ---- *)
763
764let test_option_codec () =
765 let opt_int = option int in
766 check_decode_ok "some" opt_int "value = 42" (Some 42)
767
768let test_option_roundtrip () =
769 let opt_str = option string in
770 check_roundtrip "some string" opt_str (Some "hello")
771
772(* ---- Result combinator ---- *)
773
774let string_or_int_codec : (string, int) result t = result ~ok:string ~error:int
775
776let test_result_codec () =
777 check_decode_ok "ok string" string_or_int_codec {|value = "hello"|}
778 (Ok "hello");
779 check_decode_ok "error int" string_or_int_codec "value = 42" (Error 42)
780
781let test_result_roundtrip () =
782 check_roundtrip "ok" string_or_int_codec (Ok "hello");
783 check_roundtrip "error" string_or_int_codec (Error 42)
784
785(* ---- Recursive codec ---- *)
786
787(* Simple recursive structure for testing rec' *)
788type nested_list = { value : int; next : nested_list option }
789
790let rec nested_list_codec =
791 lazy
792 Table.(
793 obj (fun value next -> { value; next })
794 |> mem "value" int ~enc:(fun n -> n.value)
795 |> opt_mem "next" (rec' nested_list_codec) ~enc:(fun n -> n.next)
796 |> finish)
797
798let test_recursive_codec () =
799 let input =
800 {|
801 [value]
802 value = 1
803
804 [value.next]
805 value = 2
806
807 [value.next.next]
808 value = 3
809 |}
810 in
811 let expected =
812 {
813 value = 1;
814 next = Some { value = 2; next = Some { value = 3; next = None } };
815 }
816 in
817 check_decode_table_ok "nested list" (rec' nested_list_codec) input expected
818
819(* ============================================================================
820 Array Codec Tests
821 ============================================================================ *)
822
823let test_list_codec () =
824 check_decode_ok "int list" (list int) "value = [1, 2, 3]" [ 1; 2; 3 ];
825 check_decode_ok "empty list" (list int) "value = []" [];
826 check_decode_ok "string list" (list string) {|value = ["a", "b", "c"]|}
827 [ "a"; "b"; "c" ]
828
829let test_list_roundtrip () =
830 check_roundtrip "int list" (list int) [ 1; 2; 3 ];
831 check_roundtrip "empty" (list int) [];
832 check_roundtrip "strings" (list string) [ "hello"; "world" ]
833
834let test_array_codec () =
835 check_decode_ok "int array" (array int) "value = [1, 2, 3]" [| 1; 2; 3 |];
836 check_decode_ok "empty array" (array int) "value = []" [||]
837
838let test_array_roundtrip () =
839 check_roundtrip "int array" (array int) [| 1; 2; 3 |];
840 check_roundtrip "empty" (array int) [||]
841
842let test_nested_list () =
843 let nested = list (list int) in
844 check_decode_ok "nested" nested "value = [[1, 2], [3, 4], [5]]"
845 [ [ 1; 2 ]; [ 3; 4 ]; [ 5 ] ];
846 check_roundtrip "nested roundtrip" nested [ [ 1; 2 ]; [ 3; 4 ] ]
847
848let test_list_of_tables () =
849 let point_codec =
850 Table.(
851 obj (fun x y -> (x, y))
852 |> mem "x" int ~enc:fst |> mem "y" int ~enc:snd |> finish)
853 in
854 let points_codec = list point_codec in
855 let input = {|value = [{x = 1, y = 2}, {x = 3, y = 4}]|} in
856 check_decode_ok "list of inline tables" points_codec input [ (1, 2); (3, 4) ]
857
858let test_list_type_error () =
859 check_decode_error "not array" (list int) "value = 42";
860 check_decode_error "mixed types" (list int) {|value = [1, "two", 3]|}
861
862(* ============================================================================
863 Table Codec Tests
864 ============================================================================ *)
865
866(* ---- Basic table ---- *)
867
868type point = { x : int; y : int }
869
870let point_codec =
871 Table.(
872 obj (fun x y -> { x; y })
873 |> mem "x" int ~enc:(fun p -> p.x)
874 |> mem "y" int ~enc:(fun p -> p.y)
875 |> finish)
876
877let test_table_codec () =
878 let input = {|
879 [value]
880 x = 10
881 y = 20
882 |} in
883 check_decode_table_ok "point" point_codec input { x = 10; y = 20 }
884
885let test_table_roundtrip () =
886 check_roundtrip "point roundtrip" point_codec { x = 5; y = 15 }
887
888let test_table_missing_member () =
889 let input = {|
890 [value]
891 x = 10
892 |} in
893 check_decode_table_error "missing y" point_codec input
894
895let test_table_type_error () =
896 check_decode_error "not table" point_codec "value = 42"
897
898(* ---- Optional members ---- *)
899
900type config = { name : string; debug : bool; timeout : int option }
901
902let config_codec =
903 Table.(
904 obj (fun name debug timeout -> { name; debug; timeout })
905 |> mem "name" string ~enc:(fun c -> c.name)
906 |> mem "debug" bool ~enc:(fun c -> c.debug) ~dec_absent:false
907 |> opt_mem "timeout" int ~enc:(fun c -> c.timeout)
908 |> finish)
909
910let test_optional_members () =
911 let input1 =
912 {|
913 [value]
914 name = "test"
915 debug = true
916 timeout = 30
917 |}
918 in
919 check_decode_table_ok "with all" config_codec input1
920 { name = "test"; debug = true; timeout = Some 30 };
921
922 let input2 = {|
923 [value]
924 name = "test"
925 |} in
926 check_decode_table_ok "with defaults" config_codec input2
927 { name = "test"; debug = false; timeout = None }
928
929let test_optional_roundtrip () =
930 let c1 = { name = "app"; debug = true; timeout = Some 60 } in
931 check_roundtrip "with timeout" config_codec c1;
932
933 let c2 = { name = "app"; debug = false; timeout = None } in
934 check_roundtrip "without timeout" config_codec c2
935
936let test_opt_mem_omits_none () =
937 let c = { name = "app"; debug = false; timeout = None } in
938 let toml = encode config_codec c in
939 (* Just verify encoding doesn't crash *)
940 let _ = toml_to_string toml in
941 (* Verify None is not encoded *)
942 match Toml.opt "timeout" toml with
943 | None -> ()
944 | Some _ -> Alcotest.fail "timeout should not be encoded when None"
945
946(* ---- enc_omit ---- *)
947
948type with_omit = { always : string; maybe : string }
949
950let with_omit_codec =
951 Table.(
952 obj (fun always maybe -> { always; maybe })
953 |> mem "always" string ~enc:(fun r -> r.always)
954 |> mem "maybe" string
955 ~enc:(fun r -> r.maybe)
956 ~dec_absent:""
957 ~enc_omit:(fun s -> String.length s = 0)
958 |> finish)
959
960let test_enc_omit () =
961 let r1 = { always = "hello"; maybe = "world" } in
962 let toml1 = encode with_omit_codec r1 in
963 (match Toml.opt "maybe" toml1 with
964 | Some _ -> ()
965 | None -> Alcotest.fail "maybe should be encoded when non-empty");
966
967 let r2 = { always = "hello"; maybe = "" } in
968 let toml2 = encode with_omit_codec r2 in
969 match Toml.opt "maybe" toml2 with
970 | None -> ()
971 | Some _ -> Alcotest.fail "maybe should be omitted when empty"
972
973(* ---- Nested tables ---- *)
974
975type server = { host : string; port : int }
976type app_config = { title : string; server : server }
977
978let server_codec =
979 Table.(
980 obj (fun host port -> { host; port })
981 |> mem "host" string ~enc:(fun s -> s.host)
982 |> mem "port" int ~enc:(fun s -> s.port)
983 |> finish)
984
985let app_config_codec =
986 Table.(
987 obj (fun title server -> { title; server })
988 |> mem "title" string ~enc:(fun c -> c.title)
989 |> mem "server" server_codec ~enc:(fun c -> c.server)
990 |> finish)
991
992let test_nested_tables () =
993 let input =
994 {|
995 [value]
996 title = "My App"
997
998 [value.server]
999 host = "localhost"
1000 port = 8080
1001 |}
1002 in
1003 check_decode_table_ok "nested" app_config_codec input
1004 { title = "My App"; server = { host = "localhost"; port = 8080 } }
1005
1006let test_nested_roundtrip () =
1007 let config =
1008 { title = "Production"; server = { host = "0.0.0.0"; port = 443 } }
1009 in
1010 check_roundtrip "nested roundtrip" app_config_codec config
1011
1012(* ---- Deeply nested tables ---- *)
1013
1014type deep = { a : int; inner : deep option }
1015
1016let rec deep_codec =
1017 lazy
1018 Table.(
1019 obj (fun a inner -> { a; inner })
1020 |> mem "a" int ~enc:(fun d -> d.a)
1021 |> opt_mem "inner" (rec' deep_codec) ~enc:(fun d -> d.inner)
1022 |> finish)
1023
1024let test_deeply_nested () =
1025 let input =
1026 {|
1027 [value]
1028 a = 1
1029
1030 [value.inner]
1031 a = 2
1032
1033 [value.inner.inner]
1034 a = 3
1035 |}
1036 in
1037 let expected =
1038 { a = 1; inner = Some { a = 2; inner = Some { a = 3; inner = None } } }
1039 in
1040 check_decode_table_ok "deep" (rec' deep_codec) input expected
1041
1042(* ---- Unknown member handling ---- *)
1043
1044type strict_config = { name : string }
1045
1046let strict_config_codec =
1047 Table.(
1048 obj (fun name -> { name })
1049 |> mem "name" string ~enc:(fun c -> c.name)
1050 |> error_unknown |> finish)
1051
1052let test_error_unknown () =
1053 let input1 = {|
1054 [value]
1055 name = "test"
1056 |} in
1057 check_decode_table_ok "known only" strict_config_codec input1
1058 { name = "test" };
1059
1060 (* error_unknown returns Error for unknown members *)
1061 let input2 = {|
1062 [value]
1063 name = "test"
1064 extra = 42
1065 |} in
1066 let toml = Tomlt_bytesrw.parse input2 in
1067 let value_toml = Toml.get "value" toml in
1068 match decode strict_config_codec value_toml with
1069 | Error _ -> ()
1070 | Ok _ -> Alcotest.fail "expected error for unknown member"
1071
1072type extensible_config = { name : string; extras : (string * Toml.t) list }
1073
1074let extensible_config_codec =
1075 Table.(
1076 obj (fun name extras -> { name; extras })
1077 |> mem "name" string ~enc:(fun c -> c.name)
1078 |> keep_unknown (Mems.assoc value) ~enc:(fun c -> c.extras)
1079 |> finish)
1080
1081let test_keep_unknown () =
1082 let input =
1083 {|
1084 [value]
1085 name = "test"
1086 extra1 = 42
1087 extra2 = "hello"
1088 |}
1089 in
1090 let toml = Tomlt_bytesrw.parse input in
1091 let value_toml = Toml.get "value" toml in
1092 match decode extensible_config_codec value_toml with
1093 | Ok c ->
1094 Alcotest.(check string) "name" "test" c.name;
1095 Alcotest.(check int) "extras count" 2 (List.length c.extras);
1096 (* Check extras contains the unknown members *)
1097 let has_extra1 = List.exists (fun (k, _) -> k = "extra1") c.extras in
1098 let has_extra2 = List.exists (fun (k, _) -> k = "extra2") c.extras in
1099 Alcotest.(check bool) "has extra1" true has_extra1;
1100 Alcotest.(check bool) "has extra2" true has_extra2
1101 | Error e -> Alcotest.failf "decode failed: %s" (Toml.Error.to_string e)
1102
1103let test_keep_unknown_roundtrip () =
1104 let c =
1105 {
1106 name = "test";
1107 extras = [ ("custom", Toml.Int 42L); ("flag", Toml.Bool true) ];
1108 }
1109 in
1110 check_roundtrip "keep_unknown roundtrip" extensible_config_codec c
1111
1112(* ---- Skip unknown (default) ---- *)
1113
1114type lenient_config = { lname : string }
1115
1116let lenient_codec =
1117 Table.(
1118 obj (fun lname -> { lname })
1119 |> mem "name" string ~enc:(fun c -> c.lname)
1120 |> skip_unknown |> finish)
1121
1122let test_skip_unknown () =
1123 let input =
1124 {|
1125 [value]
1126 name = "test"
1127 ignored = 42
1128 also_ignored = "hello"
1129 |}
1130 in
1131 check_decode_table_ok "skip unknown" lenient_codec input { lname = "test" }
1132
1133(* ============================================================================
1134 Array of Tables Tests
1135 ============================================================================ *)
1136
1137type product = { name : string; price : float }
1138
1139let product_codec =
1140 Table.(
1141 obj (fun name price -> { name; price })
1142 |> mem "name" string ~enc:(fun p -> p.name)
1143 |> mem "price" float ~enc:(fun p -> p.price)
1144 |> finish)
1145
1146let test_array_of_tables () =
1147 let products_codec = array_of_tables product_codec in
1148 let input =
1149 {|
1150 [[value]]
1151 name = "Apple"
1152 price = 1.50
1153
1154 [[value]]
1155 name = "Banana"
1156 price = 0.75
1157 |}
1158 in
1159 let expected =
1160 [ { name = "Apple"; price = 1.50 }; { name = "Banana"; price = 0.75 } ]
1161 in
1162 check_decode_ok "products" products_codec input expected
1163
1164let test_array_of_tables_roundtrip () =
1165 let products_codec = array_of_tables product_codec in
1166 let products =
1167 [ { name = "Apple"; price = 1.50 }; { name = "Banana"; price = 0.75 } ]
1168 in
1169 check_roundtrip "products roundtrip" products_codec products
1170
1171let test_array_of_tables_empty () =
1172 let products_codec = array_of_tables product_codec in
1173 check_decode_ok "empty" products_codec "value = []" []
1174
1175(* ============================================================================
1176 Any/Value Codec Tests
1177 ============================================================================ *)
1178
1179let test_value_codec () =
1180 check_decode_ok "int" value "value = 42" (Toml.Int 42L);
1181 check_decode_ok "string" value {|value = "hello"|} (Toml.String "hello");
1182 check_decode_ok "bool" value "value = true" (Toml.Bool true);
1183 check_decode_ok "float" value "value = 3.14" (Toml.Float 3.14);
1184 check_decode_ok "array" value "value = [1, 2, 3]"
1185 (Toml.Array [ Toml.Int 1L; Toml.Int 2L; Toml.Int 3L ])
1186
1187let test_value_roundtrip () =
1188 check_roundtrip "int" value (Toml.Int 42L);
1189 check_roundtrip "string" value (Toml.String "hello");
1190 check_roundtrip "bool" value (Toml.Bool true)
1191
1192let test_value_mems_codec () =
1193 let input = {|
1194 [value]
1195 a = 1
1196 b = "hello"
1197 c = true
1198 |} in
1199 let toml = Tomlt_bytesrw.parse input in
1200 let v = Toml.get "value" toml in
1201 match decode value_mems v with
1202 | Ok pairs ->
1203 Alcotest.(check int) "count" 3 (List.length pairs);
1204 let has_a = List.exists (fun (k, _) -> k = "a") pairs in
1205 let has_b = List.exists (fun (k, _) -> k = "b") pairs in
1206 let has_c = List.exists (fun (k, _) -> k = "c") pairs in
1207 Alcotest.(check bool) "has a" true has_a;
1208 Alcotest.(check bool) "has b" true has_b;
1209 Alcotest.(check bool) "has c" true has_c
1210 | Error e -> Alcotest.failf "decode failed: %s" (Toml.Error.to_string e)
1211
1212type string_or_int_any = String of string | Int of int
1213
1214let string_or_int_any_codec =
1215 any ()
1216 ~dec_string:(map string ~dec:(fun s -> String s))
1217 ~dec_int:(map int ~dec:(fun i -> Int i))
1218 ~enc:(function
1219 | String _ -> map string ~enc:(function String s -> s | _ -> "")
1220 | Int _ -> map int ~enc:(function Int i -> i | _ -> 0))
1221
1222let test_any_codec () =
1223 check_decode_ok "string" string_or_int_any_codec {|value = "hello"|}
1224 (String "hello");
1225 check_decode_ok "int" string_or_int_any_codec "value = 42" (Int 42)
1226
1227let test_any_type_error () =
1228 check_decode_error "bool not handled" string_or_int_any_codec "value = true"
1229
1230(* ============================================================================
1231 Encoding/Decoding Function Tests
1232 ============================================================================ *)
1233
1234let test_decode_string () =
1235 let toml_str = {|name = "test"|} in
1236 let codec =
1237 Table.(obj (fun name -> name) |> mem "name" string ~enc:Fun.id |> finish)
1238 in
1239 match Tomlt_bytesrw.decode_string codec toml_str with
1240 | Ok name -> Alcotest.(check string) "name" "test" name
1241 | Error e -> Alcotest.failf "decode failed: %s" (Toml.Error.to_string e)
1242
1243let test_decode_string_exn () =
1244 let toml_str = {|value = 42|} in
1245 let toml = Tomlt_bytesrw.parse toml_str in
1246 let v = Toml.get "value" toml in
1247 let result = decode_exn int v in
1248 Alcotest.(check int) "value" 42 result
1249
1250let test_encode_string () =
1251 let codec =
1252 Table.(obj (fun name -> name) |> mem "name" string ~enc:Fun.id |> finish)
1253 in
1254 let s = Tomlt_bytesrw.encode_string codec "test" in
1255 (* Just verify it produces valid TOML *)
1256 let _ = Tomlt_bytesrw.parse s in
1257 ()
1258
1259(* ============================================================================
1260 Edge Cases and Error Handling
1261 ============================================================================ *)
1262
1263let test_empty_table () =
1264 let empty_codec = Table.(obj () |> finish) in
1265 let input = "[value]" in
1266 check_decode_table_ok "empty table" empty_codec input ()
1267
1268let test_unicode_keys () =
1269 let codec =
1270 Table.(
1271 obj (fun v -> v)
1272 |> mem "\xE4\xB8\xAD\xE6\x96\x87" string ~enc:Fun.id (* "中文" in UTF-8 *)
1273 |> finish)
1274 in
1275 let input = {|
1276 [value]
1277 "中文" = "hello"
1278 |} in
1279 check_decode_table_ok "unicode key" codec input "hello"
1280
1281let test_special_string_values () =
1282 check_decode_ok "empty" string {|value = ""|} "";
1283 check_decode_ok "spaces" string {|value = " "|} " ";
1284 check_decode_ok "newlines" string {|value = "a\nb\nc"|} "a\nb\nc"
1285
1286let test_large_integers () =
1287 check_decode_ok "large" int64 "value = 9007199254740992" 9007199254740992L;
1288 check_decode_ok "max i64" int64 "value = 9223372036854775807"
1289 9223372036854775807L
1290
1291let test_codec_kind_doc () =
1292 Alcotest.(check string) "bool kind" "boolean" (kind bool);
1293 Alcotest.(check string) "int kind" "integer" (kind int);
1294 Alcotest.(check string) "string kind" "string" (kind string);
1295 Alcotest.(check string) "float kind" "float" (kind float);
1296
1297 let documented = with_doc ~kind:"custom" ~doc:"A custom codec" int in
1298 Alcotest.(check string) "custom kind" "custom" (kind documented);
1299 Alcotest.(check string) "custom doc" "A custom codec" (doc documented)
1300
1301let test_duplicate_member_error () =
1302 try
1303 let _ =
1304 Table.(
1305 obj (fun a b -> (a, b))
1306 |> mem "same" int ~enc:fst |> mem "same" int ~enc:snd |> finish)
1307 in
1308 Alcotest.fail "should raise on duplicate member"
1309 with Invalid_argument _ -> ()
1310
1311(* ============================================================================
1312 Test Registration
1313 ============================================================================ *)
1314
1315let tz_tests =
1316 [
1317 ("utc", `Quick, test_tz_utc);
1318 ("offset", `Quick, test_tz_offset);
1319 ("parse", `Quick, test_tz_parse);
1320 ("compare", `Quick, test_tz_compare);
1321 ]
1322
1323let date_tests =
1324 [
1325 ("basic", `Quick, test_date_basic);
1326 ("equal", `Quick, test_date_equal);
1327 ("compare", `Quick, test_date_compare);
1328 ("parse", `Quick, test_date_parse);
1329 ("edge cases", `Quick, test_date_edge_cases);
1330 ]
1331
1332let time_tests =
1333 [
1334 ("basic", `Quick, test_time_basic);
1335 ("fractional", `Quick, test_time_fractional);
1336 ("equal", `Quick, test_time_equal);
1337 ("compare", `Quick, test_time_compare);
1338 ("parse", `Quick, test_time_parse);
1339 ("edge cases", `Quick, test_time_edge_cases);
1340 ]
1341
1342let datetime_tests =
1343 [
1344 ("basic", `Quick, test_datetime_basic);
1345 ("with offset", `Quick, test_datetime_with_offset);
1346 ("with frac", `Quick, test_datetime_with_frac);
1347 ("parse", `Quick, test_datetime_parse);
1348 ("equal compare", `Quick, test_datetime_equal_compare);
1349 ]
1350
1351let datetime_local_tests =
1352 [
1353 ("basic", `Quick, test_datetime_local_basic);
1354 ("parse", `Quick, test_datetime_local_parse);
1355 ("equal compare", `Quick, test_datetime_local_equal_compare);
1356 ]
1357
1358let bool_tests =
1359 [
1360 ("codec", `Quick, test_bool_codec);
1361 ("roundtrip", `Quick, test_bool_roundtrip);
1362 ("type error", `Quick, test_bool_type_error);
1363 ]
1364
1365let int_tests =
1366 [
1367 ("codec", `Quick, test_int_codec);
1368 ("formats", `Quick, test_int_formats);
1369 ("roundtrip", `Quick, test_int_roundtrip);
1370 ("type error", `Quick, test_int_type_error);
1371 ]
1372
1373let int32_tests =
1374 [
1375 ("codec", `Quick, test_int32_codec);
1376 ("roundtrip", `Quick, test_int32_roundtrip);
1377 ]
1378
1379let int64_tests =
1380 [
1381 ("codec", `Quick, test_int64_codec);
1382 ("roundtrip", `Quick, test_int64_roundtrip);
1383 ]
1384
1385let float_tests =
1386 [
1387 ("codec", `Quick, test_float_codec);
1388 ("special", `Quick, test_float_special);
1389 ("roundtrip", `Quick, test_float_roundtrip);
1390 ("type error", `Quick, test_float_type_error);
1391 ]
1392
1393let number_tests =
1394 [
1395 ("codec", `Quick, test_number_codec);
1396 ("type error", `Quick, test_number_type_error);
1397 ]
1398
1399let string_tests =
1400 [
1401 ("codec", `Quick, test_string_codec);
1402 ("escapes", `Quick, test_string_escapes);
1403 ("multiline", `Quick, test_string_multiline);
1404 ("roundtrip", `Quick, test_string_roundtrip);
1405 ("type error", `Quick, test_string_type_error);
1406 ]
1407
1408let ptime_codec_tests =
1409 [
1410 ("ptime offset datetime", `Quick, test_ptime_codec);
1411 ("ptime with timezone offset", `Quick, test_ptime_codec_offset);
1412 ("ptime roundtrip", `Quick, test_ptime_codec_roundtrip);
1413 ("ptime optional seconds", `Quick, test_ptime_codec_optional_seconds);
1414 ("ptime_opt", `Quick, test_ptime_opt_codec);
1415 ("ptime_opt rejects local", `Quick, test_ptime_opt_rejects_local);
1416 ("ptime_span", `Quick, test_ptime_span_codec);
1417 ("ptime_span roundtrip", `Quick, test_ptime_span_roundtrip);
1418 ("ptime_date", `Quick, test_ptime_date_codec);
1419 ("ptime_date roundtrip", `Quick, test_ptime_date_roundtrip);
1420 ("ptime local datetime", `Quick, test_ptime_local_datetime);
1421 ("ptime date as ptime", `Quick, test_ptime_date_as_ptime);
1422 ]
1423
1424let ptime_full_codec_tests =
1425 [
1426 ("offset datetime", `Quick, test_ptime_full_offset);
1427 ("local datetime", `Quick, test_ptime_full_local_datetime);
1428 ("local date", `Quick, test_ptime_full_date);
1429 ("local time", `Quick, test_ptime_full_time);
1430 ("roundtrip", `Quick, test_ptime_full_roundtrip);
1431 ]
1432
1433let combinator_tests =
1434 [
1435 ("map", `Quick, test_map_combinator);
1436 ("map roundtrip", `Quick, test_map_roundtrip);
1437 ("map int", `Quick, test_map_int);
1438 ("const", `Quick, test_const);
1439 ("enum", `Quick, test_enum);
1440 ("enum roundtrip", `Quick, test_enum_roundtrip);
1441 ("enum unknown", `Quick, test_enum_unknown);
1442 ("enum type error", `Quick, test_enum_type_error);
1443 ("option", `Quick, test_option_codec);
1444 ("option roundtrip", `Quick, test_option_roundtrip);
1445 ("result", `Quick, test_result_codec);
1446 ("result roundtrip", `Quick, test_result_roundtrip);
1447 ("recursive", `Quick, test_recursive_codec);
1448 ]
1449
1450let array_tests =
1451 [
1452 ("list", `Quick, test_list_codec);
1453 ("list roundtrip", `Quick, test_list_roundtrip);
1454 ("array", `Quick, test_array_codec);
1455 ("array roundtrip", `Quick, test_array_roundtrip);
1456 ("nested list", `Quick, test_nested_list);
1457 ("list of tables", `Quick, test_list_of_tables);
1458 ("list type error", `Quick, test_list_type_error);
1459 ]
1460
1461let table_tests =
1462 [
1463 ("basic", `Quick, test_table_codec);
1464 ("roundtrip", `Quick, test_table_roundtrip);
1465 ("missing member", `Quick, test_table_missing_member);
1466 ("type error", `Quick, test_table_type_error);
1467 ("optional members", `Quick, test_optional_members);
1468 ("optional roundtrip", `Quick, test_optional_roundtrip);
1469 ("opt_mem omits none", `Quick, test_opt_mem_omits_none);
1470 ("enc_omit", `Quick, test_enc_omit);
1471 ("nested tables", `Quick, test_nested_tables);
1472 ("nested roundtrip", `Quick, test_nested_roundtrip);
1473 ("deeply nested", `Quick, test_deeply_nested);
1474 ("error unknown", `Quick, test_error_unknown);
1475 ("keep unknown", `Quick, test_keep_unknown);
1476 ("keep unknown roundtrip", `Quick, test_keep_unknown_roundtrip);
1477 ("skip unknown", `Quick, test_skip_unknown);
1478 ]
1479
1480let array_of_tables_tests =
1481 [
1482 ("basic", `Quick, test_array_of_tables);
1483 ("roundtrip", `Quick, test_array_of_tables_roundtrip);
1484 ("empty", `Quick, test_array_of_tables_empty);
1485 ]
1486
1487let any_value_tests =
1488 [
1489 ("value codec", `Quick, test_value_codec);
1490 ("value roundtrip", `Quick, test_value_roundtrip);
1491 ("value_mems", `Quick, test_value_mems_codec);
1492 ("any codec", `Quick, test_any_codec);
1493 ("any type error", `Quick, test_any_type_error);
1494 ]
1495
1496let function_tests =
1497 [
1498 ("decode_string", `Quick, test_decode_string);
1499 ("decode_exn", `Quick, test_decode_string_exn);
1500 ("encode_string", `Quick, test_encode_string);
1501 ]
1502
1503let edge_case_tests =
1504 [
1505 ("empty table", `Quick, test_empty_table);
1506 ("unicode keys", `Quick, test_unicode_keys);
1507 ("special strings", `Quick, test_special_string_values);
1508 ("large integers", `Quick, test_large_integers);
1509 ("codec kind doc", `Quick, test_codec_kind_doc);
1510 ("duplicate member error", `Quick, test_duplicate_member_error);
1511 ]
1512
1513let suite =
1514 ( "codec",
1515 List.concat
1516 [
1517 tz_tests;
1518 date_tests;
1519 time_tests;
1520 datetime_tests;
1521 datetime_local_tests;
1522 bool_tests;
1523 int_tests;
1524 int32_tests;
1525 int64_tests;
1526 float_tests;
1527 number_tests;
1528 string_tests;
1529 ptime_codec_tests;
1530 ptime_full_codec_tests;
1531 combinator_tests;
1532 array_tests;
1533 table_tests;
1534 array_of_tables_tests;
1535 any_value_tests;
1536 function_tests;
1537 edge_case_tests;
1538 ] )