simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-03-07 21:27:55 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

wip

Browse source
This commit is contained in:
Simon Cruanes 2026-02-10 21:27:49 -05:00
parent 84c3270718
commit 7ec6485ab4
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
4 changed files with 496 additions and 386 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/core/dune
View file

@ -3,10 +3,7 @@
(public_name containers) (public_name containers)
(wrapped false) (wrapped false)
(preprocess (preprocess
(per_module (action (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
((action (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))
CCAtomic CCList CCVector)
((pps bisect_ppx))))
(flags :standard -nolabels -open CCMonomorphic) (flags :standard -nolabels -open CCMonomorphic)
(libraries either containers.monomorphic containers.domain)) (libraries either containers.monomorphic containers.domain))

275
tests/core/t_cbor.ml
View file

@ -68,8 +68,8 @@ let gen_c : Cbor.t Q.Gen.t =
let rec shrink (c : Cbor.t) : Cbor.t Q.Iter.t = let rec shrink (c : Cbor.t) : Cbor.t Q.Iter.t =
let open Q.Iter in let open Q.Iter in
match c with match c with
| `Null | `Undefined | (`Bool false) -> empty | `Null | `Undefined | `Bool false -> empty
| (`Bool true) -> return ((`Bool false)) | `Bool true -> return (`Bool false)
| `Simple i -> | `Simple i ->
let+ i = Q.Shrink.int i in let+ i = Q.Shrink.int i in
`Simple i `Simple i
@ -123,15 +123,16 @@ let c' = Cbor.decode_exn s in
if not (eq_c c c') then if not (eq_c c c') then
Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]" Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]"
Cbor.pp_diagnostic c Cbor.pp_diagnostic c'; Cbor.pp_diagnostic c Cbor.pp_diagnostic c';
true;; true
;;
(* Additional edge case and error handling tests *) (* Additional edge case and error handling tests *)
(* Test basic encoding/decoding *) (* Test basic encoding/decoding *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode `Null) = `Null;; t @@ fun () -> Cbor.decode_exn (Cbor.encode `Null) = `Null;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode `Undefined) = `Undefined;; t @@ fun () -> Cbor.decode_exn (Cbor.encode `Undefined) = `Undefined;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bool true)) = (`Bool true);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bool true)) = `Bool true;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bool false)) = (`Bool false);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bool false)) = `Bool false;;
(* Test integer edge cases *) (* Test integer edge cases *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 0L)) = `Int 0L;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 0L)) = `Int 0L;;
@ -141,114 +142,137 @@ t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 255L)) = `Int 255L;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 256L)) = `Int 256L;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 256L)) = `Int 256L;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 65535L)) = `Int 65535L;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 65535L)) = `Int 65535L;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 65536L)) = `Int 65536L;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int 65536L)) = `Int 65536L;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int Int64.max_int)) = `Int Int64.max_int;;
t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Int Int64.max_int)) = `Int Int64.max_int
;;
(* Test negative integers *) (* Test negative integers *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-1L))) = `Int (-1L);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-1L))) = `Int (-1L);;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-23L))) = `Int (-23L);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-23L))) = `Int (-23L);;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-24L))) = `Int (-24L);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-24L))) = `Int (-24L);;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-256L))) = `Int (-256L);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int (-256L))) = `Int (-256L);;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Int Int64.min_int)) = `Int Int64.min_int;;
t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Int Int64.min_int)) = `Int Int64.min_int
;;
(* Test floats *) (* Test floats *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float 0.0)) = `Float 0.0;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float 0.0)) = `Float 0.0;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float 1.5)) = `Float 1.5;; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float 1.5)) = `Float 1.5;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float (-1.5))) = `Float (-1.5);; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Float (-1.5))) = `Float (-1.5);;
t @@ fun () -> t @@ fun () ->
let result = Cbor.decode_exn (Cbor.encode (`Float infinity)) in let result = Cbor.decode_exn (Cbor.encode (`Float infinity)) in
match result with match result with
| `Float f -> classify_float f = FP_infinite && f > 0.0 | `Float f -> classify_float f = FP_infinite && f > 0.0
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
let result = Cbor.decode_exn (Cbor.encode (`Float neg_infinity)) in let result = Cbor.decode_exn (Cbor.encode (`Float neg_infinity)) in
match result with match result with
| `Float f -> classify_float f = FP_infinite && f < 0.0 | `Float f -> classify_float f = FP_infinite && f < 0.0
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
let result = Cbor.decode_exn (Cbor.encode (`Float nan)) in let result = Cbor.decode_exn (Cbor.encode (`Float nan)) in
match result with match result with
| `Float f -> classify_float f = FP_nan | `Float f -> classify_float f = FP_nan
| _ -> false | _ -> false
;; ;;
(* Test strings *) (* Test strings *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "")) = `Text "";; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "")) = `Text "";;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "hello")) = `Text "hello";; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "hello")) = `Text "hello";;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "a")) = `Text "a";; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "a")) = `Text "a";;
t @@ fun () -> t @@ fun () ->
let long = String.make 1000 'x' in let long = String.make 1000 'x' in
Cbor.decode_exn (Cbor.encode (`Text long)) = `Text long Cbor.decode_exn (Cbor.encode (`Text long)) = `Text long
;; ;;
(* Test UTF-8 strings *) (* Test UTF-8 strings *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "hello 世界")) = `Text "hello 世界";; t @@ fun () ->
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "émoji 🎉")) = `Text "émoji 🎉";; Cbor.decode_exn (Cbor.encode (`Text "hello 世界")) = `Text "hello 世界"
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "Здравствуй")) = `Text "Здравствуй";; ;;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Text "émoji 🎉")) = `Text "émoji 🎉"
;;
t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Text "Здравствуй")) = `Text "Здравствуй"
;;
(* Test bytes *) (* Test bytes *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bytes "")) = `Bytes "";; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bytes "")) = `Bytes "";;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Bytes "\x00\x01\x02")) = `Bytes "\x00\x01\x02";;
t @@ fun () -> t @@ fun () ->
let bytes = String.init 256 char_of_int in Cbor.decode_exn (Cbor.encode (`Bytes "\x00\x01\x02")) = `Bytes "\x00\x01\x02"
Cbor.decode_exn (Cbor.encode (`Bytes bytes)) = `Bytes bytes ;;
t @@ fun () ->
let bytes = String.init 256 char_of_int in
Cbor.decode_exn (Cbor.encode (`Bytes bytes)) = `Bytes bytes
;; ;;
(* Test arrays *) (* Test arrays *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Array [])) = `Array [];; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Array [])) = `Array [];;
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Array [`Int 1L])) = `Array [`Int 1L];;
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Array [`Int 1L; `Int 2L; `Int 3L])) Cbor.decode_exn (Cbor.encode (`Array [ `Int 1L ])) = `Array [ `Int 1L ]
= `Array [`Int 1L; `Int 2L; `Int 3L]
;; ;;
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Array [(`Bool true); `Text "a"; `Int 42L])) Cbor.decode_exn (Cbor.encode (`Array [ `Int 1L; `Int 2L; `Int 3L ]))
= `Array [(`Bool true); `Text "a"; `Int 42L] = `Array [ `Int 1L; `Int 2L; `Int 3L ]
;;
t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Array [ `Bool true; `Text "a"; `Int 42L ]))
= `Array [ `Bool true; `Text "a"; `Int 42L ]
;; ;;
(* Test nested arrays *) (* Test nested arrays *)
t @@ fun () -> t @@ fun () ->
let nested = `Array [`Array [`Int 1L; `Int 2L]; `Array [`Int 3L]] in let nested = `Array [ `Array [ `Int 1L; `Int 2L ]; `Array [ `Int 3L ] ] in
Cbor.decode_exn (Cbor.encode nested) = nested Cbor.decode_exn (Cbor.encode nested) = nested
;; ;;
(* Test maps *) (* Test maps *)
t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Map [])) = `Map [];; t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Map [])) = `Map [];;
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Map [(`Text "key", `Int 42L)])) Cbor.decode_exn (Cbor.encode (`Map [ `Text "key", `Int 42L ]))
= `Map [(`Text "key", `Int 42L)] = `Map [ `Text "key", `Int 42L ]
;; ;;
t @@ fun () -> t @@ fun () ->
let map = `Map [ let map = `Map [ `Text "a", `Int 1L; `Text "b", `Int 2L; `Text "c", `Int 3L ] in
(`Text "a", `Int 1L); Cbor.decode_exn (Cbor.encode map) = map
(`Text "b", `Int 2L);
(`Text "c", `Int 3L)
] in
Cbor.decode_exn (Cbor.encode map) = map
;; ;;
(* Test maps with various key types *) (* Test maps with various key types *)
t @@ fun () -> t @@ fun () ->
let map = `Map [ let map = `Map [ `Int 0L, `Text "zero"; `Int 1L, `Text "one" ] in
(`Int 0L, `Text "zero"); Cbor.decode_exn (Cbor.encode map) = map
(`Int 1L, `Text "one");
] in
Cbor.decode_exn (Cbor.encode map) = map
;; ;;
(* Test tags *) (* Test tags *)
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Tag (0, `Text "2013-03-21"))) Cbor.decode_exn (Cbor.encode (`Tag (0, `Text "2013-03-21")))
= `Tag (0, `Text "2013-03-21") = `Tag (0, `Text "2013-03-21")
;; ;;
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Tag (1, `Int 1363896240L))) Cbor.decode_exn (Cbor.encode (`Tag (1, `Int 1363896240L)))
= `Tag (1, `Int 1363896240L) = `Tag (1, `Int 1363896240L)
;; ;;
t @@ fun () -> t @@ fun () ->
Cbor.decode_exn (Cbor.encode (`Tag (32, `Text "http://example.com"))) Cbor.decode_exn (Cbor.encode (`Tag (32, `Text "http://example.com")))
= `Tag (32, `Text "http://example.com") = `Tag (32, `Text "http://example.com")
;; ;;
(* Test simple values *) (* Test simple values *)
@ -258,142 +282,149 @@ t @@ fun () -> Cbor.decode_exn (Cbor.encode (`Simple 255)) = `Simple 255;;
(* Test error cases *) (* Test error cases *)
t @@ fun () -> t @@ fun () ->
match Cbor.decode "" with match Cbor.decode "" with
| Error _ -> true | Error _ -> true
| Ok _ -> false | Ok _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match Cbor.decode "\x1f" with (* invalid additional info *) match Cbor.decode "\x1f" with
| Error _ -> true (* invalid additional info *)
| Ok _ -> false | Error _ -> true
| Ok _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match Cbor.decode "\x1c" with (* reserved additional info *) match Cbor.decode "\x1c" with
| Error _ -> true (* reserved additional info *)
| Ok _ -> false | Error _ -> true
| Ok _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match Cbor.decode "\x5f\x42\x01\x02\x43\x03\x04\x05" with (* incomplete indefinite *) match Cbor.decode "\x5f\x42\x01\x02\x43\x03\x04\x05" with
| Error _ -> true (* incomplete indefinite *)
| Ok _ -> false | Error _ -> true
| Ok _ -> false
;; ;;
(* Test that decode_exn raises on invalid input *) (* Test that decode_exn raises on invalid input *)
t @@ fun () -> t @@ fun () ->
try try
ignore (Cbor.decode_exn ""); ignore (Cbor.decode_exn "");
false false
with Failure _ -> true with Failure _ -> true
;; ;;
t @@ fun () -> t @@ fun () ->
try try
ignore (Cbor.decode_exn "\x1c"); ignore (Cbor.decode_exn "\x1c");
false false
with Failure _ -> true with Failure _ -> true
;; ;;
(* Test diagnostic string output *) (* Test diagnostic string output *)
t @@ fun () -> Cbor.to_string_diagnostic `Null = "null";; t @@ fun () -> Cbor.to_string_diagnostic `Null = "null";;
t @@ fun () -> Cbor.to_string_diagnostic `Undefined = "undefined";; t @@ fun () -> Cbor.to_string_diagnostic `Undefined = "undefined";;
t @@ fun () -> Cbor.to_string_diagnostic ((`Bool true)) = "true";; t @@ fun () -> Cbor.to_string_diagnostic (`Bool true) = "true";;
t @@ fun () -> Cbor.to_string_diagnostic ((`Bool false)) = "false";; t @@ fun () -> Cbor.to_string_diagnostic (`Bool false) = "false";;
t @@ fun () -> Cbor.to_string_diagnostic (`Int 42L) = "42";; t @@ fun () -> Cbor.to_string_diagnostic (`Int 42L) = "42";;
t @@ fun () -> Cbor.to_string_diagnostic (`Int (-42L)) = "-42";; t @@ fun () -> Cbor.to_string_diagnostic (`Int (-42L)) = "-42";;
t @@ fun () -> Cbor.to_string_diagnostic (`Float 1.5) = "1.5";; t @@ fun () -> Cbor.to_string_diagnostic (`Float 1.5) = "1.5";;
t @@ fun () -> Cbor.to_string_diagnostic (`Text "hello") = "\"hello\"";; t @@ fun () -> Cbor.to_string_diagnostic (`Text "hello") = "\"hello\"";;
t @@ fun () -> Cbor.to_string_diagnostic (`Array [`Int 1L; `Int 2L]) = "[1, 2]";;
t @@ fun () -> t @@ fun () ->
Cbor.to_string_diagnostic (`Map [(`Text "a", `Int 1L)]) Cbor.to_string_diagnostic (`Array [ `Int 1L; `Int 2L ]) = "[1, 2]"
|> String.contains_s ~sub:"\"a\"" ;;
t @@ fun () ->
Cbor.to_string_diagnostic (`Map [ `Text "a", `Int 1L ])
|> CCString.mem ~sub:"\"a\""
;; ;;
(* Test deeply nested structures *) (* Test deeply nested structures *)
t @@ fun () -> t @@ fun () ->
let rec make_nested n = let rec make_nested n =
if n = 0 then `Int 0L if n = 0 then
else `Array [make_nested (n - 1)] `Int 0L
in else
let nested = make_nested 100 in `Array [ make_nested (n - 1) ]
Cbor.decode_exn (Cbor.encode nested) = nested in
let nested = make_nested 100 in
Cbor.decode_exn (Cbor.encode nested) = nested
;; ;;
(* Test large collections *) (* Test large collections *)
t @@ fun () -> t @@ fun () ->
let large_array = `Array (List.init 1000 (fun i -> `Int (Int64.of_int i))) in let large_array = `Array (List.init 1000 (fun i -> `Int (Int64.of_int i))) in
Cbor.decode_exn (Cbor.encode large_array) = large_array Cbor.decode_exn (Cbor.encode large_array) = large_array
;; ;;
t @@ fun () -> t @@ fun () ->
let large_map = `Map (List.init 500 (fun i -> let large_map =
(`Int (Int64.of_int i), `Text (string_of_int i)) `Map (List.init 500 (fun i -> `Int (Int64.of_int i), `Text (string_of_int i)))
)) in in
Cbor.decode_exn (Cbor.encode large_map) = large_map Cbor.decode_exn (Cbor.encode large_map) = large_map
;; ;;
(* Test mixed nested structures *) (* Test mixed nested structures *)
t @@ fun () -> t @@ fun () ->
let complex = `Map [ let complex =
(`Text "array", `Array [`Int 1L; `Int 2L; `Int 3L]); `Map
(`Text "map", `Map [(`Text "nested", (`Bool true))]); [
(`Text "tagged", `Tag (42, `Text "value")); `Text "array", `Array [ `Int 1L; `Int 2L; `Int 3L ];
(`Text "null", `Null); `Text "map", `Map [ `Text "nested", `Bool true ];
] in `Text "tagged", `Tag (42, `Text "value");
Cbor.decode_exn (Cbor.encode complex) = complex `Text "null", `Null;
]
in
Cbor.decode_exn (Cbor.encode complex) = complex
;; ;;
(* Test that encoding is consistent *) (* Test that encoding is consistent *)
t @@ fun () -> t @@ fun () ->
let c = `Map [(`Text "a", `Int 1L); (`Text "b", `Int 2L)] in let c = `Map [ `Text "a", `Int 1L; `Text "b", `Int 2L ] in
let e1 = Cbor.encode c in let e1 = Cbor.encode c in
let e2 = Cbor.encode c in let e2 = Cbor.encode c in
e1 = e2 e1 = e2
;; ;;
(* Test buffer reuse *) (* Test buffer reuse *)
t @@ fun () -> t @@ fun () ->
let buf = Buffer.create 16 in let buf = Buffer.create 16 in
let _ = Cbor.encode ~buf (`Int 1L) in let _ = Cbor.encode ~buf (`Int 1L) in
let s1 = Buffer.contents buf in let s1 = Buffer.contents buf in
Buffer.clear buf; Buffer.clear buf;
let _ = Cbor.encode ~buf (`Int 1L) in let _ = Cbor.encode ~buf (`Int 1L) in
let s2 = Buffer.contents buf in let s2 = Buffer.contents buf in
s1 = s2 s1 = s2
;; ;;
(* Property: encoding then decoding gives original value *) (* Property: encoding then decoding gives original value *)
q ~count:5000 arb @@ fun c -> q ~count:5000 arb @@ fun c ->
match Cbor.decode (Cbor.encode c) with match Cbor.decode (Cbor.encode c) with
| Ok c' -> eq_c c c' | Ok c' -> eq_c c c'
| Error e -> | Error e -> Q.Test.fail_reportf "decode failed: %s" e
Q.Test.fail_reportf "decode failed: %s" e;
false
;; ;;
(* Property: decode result equality *) (* Property: decode result equality *)
q ~count:2000 arb @@ fun c -> q ~count:2000 arb @@ fun c ->
let s = Cbor.encode c in let s = Cbor.encode c in
match Cbor.decode s with match Cbor.decode s with
| Error e -> | Error e -> Q.Test.fail_reportf "decode failed on encoded value: %s" e
Q.Test.fail_reportf "decode failed on encoded value: %s" e; | Ok c1 ->
false (match Cbor.decode s with
| Ok c1 ->
match Cbor.decode s with
| Error _ -> false | Error _ -> false
| Ok c2 -> eq_c c1 c2 | Ok c2 -> eq_c c1 c2)
;; ;;
(* Property: diagnostic string doesn't crash *) (* Property: diagnostic string doesn't crash *)
q ~count:1000 arb @@ fun c -> q ~count:1000 arb @@ fun c ->
let _ = Cbor.to_string_diagnostic c in let _ = Cbor.to_string_diagnostic c in
true true
;; ;;
(* Property: encoding size is reasonable *) (* Property: encoding size is reasonable *)
q ~count:1000 arb @@ fun c -> q ~count:1000 arb @@ fun c ->
let s = Cbor.encode c in let s = Cbor.encode c in
String.length s < 1_000_000 (* Sanity check *) String.length s < 1_000_000 (* Sanity check *)
;;

267
tests/core/t_list.ml
View file

@ -306,11 +306,10 @@ q
Q.( Q.(
let p = list_small int in let p = list_small int in
pair p p) pair p p)
(fun (l1, l2) -> Q.(
if List.length l1 = List.length l2 then fun (l1, l2) ->
CCList.combine l1 l2 = List.combine l1 l2 List.length l1 = List.length l2
else ==> (CCList.combine l1 l2 = List.combine l1 l2))
Q.assume_fail ())
;; ;;
q q
@ -1161,193 +1160,217 @@ eq
~pp_start:(fun fmt () -> Format.fprintf fmt "[") ~pp_start:(fun fmt () -> Format.fprintf fmt "[")
~pp_stop:(fun fmt () -> Format.fprintf fmt "]") ~pp_stop:(fun fmt () -> Format.fprintf fmt "]")
CCFormat.int)) CCFormat.int))
[ 1; 2; 3 ]);; [ 1; 2; 3 ])
;;
(* Additional edge case and property tests *) (* Additional edge case and property tests *)
(* Test interleave *) (* Test interleave *)
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
CCList.interleave [1; 3; 5] [2; 4; 6] = [1; 2; 3; 4; 5; 6] CCList.interleave [ 1; 3; 5 ] [ 2; 4; 6 ] = [ 1; 2; 3; 4; 5; 6 ]
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
CCList.interleave [1; 2] [10; 20; 30; 40] = [1; 10; 2; 20; 30; 40] CCList.interleave [ 1; 2 ] [ 10; 20; 30; 40 ] = [ 1; 10; 2; 20; 30; 40 ]
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
CCList.interleave [1; 2; 3; 4] [10; 20] = [1; 10; 2; 20; 3; 4] CCList.interleave [ 1; 2; 3; 4 ] [ 10; 20 ] = [ 1; 10; 2; 20; 3; 4 ]
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () -> CCList.interleave [] [ 1; 2; 3 ] = [ 1; 2; 3 ];;
CCList.interleave [] [1; 2; 3] = [1; 2; 3] t ~name:__LOC__ @@ fun () -> CCList.interleave [ 1; 2; 3 ] [] = [ 1; 2; 3 ];;
;;
t @@ fun () ->
CCList.interleave [1; 2; 3] [] = [1; 2; 3]
;;
(* Test take_while and drop_while *) (* Test take_while and drop_while *)
eq [1; 2; 3] (CCList.take_while (fun x -> x < 4) [1; 2; 3; 4; 5]);; eq ~name:__LOC__ [ 1; 2; 3 ]
eq [] (CCList.take_while (fun x -> x < 0) [1; 2; 3]);; (CCList.take_while (fun x -> x < 4) [ 1; 2; 3; 4; 5 ])
eq [1; 2; 3] (CCList.take_while (fun _ -> true) [1; 2; 3]);;
eq [4; 5] (CCList.drop_while (fun x -> x < 4) [1; 2; 3; 4; 5]);;
eq [1; 2; 3] (CCList.drop_while (fun x -> x < 0) [1; 2; 3]);;
eq [] (CCList.drop_while (fun _ -> true) [1; 2; 3]);;
(* Test find_map *)
eq (Some 4)
(CCList.find_map (fun x -> if x > 3 then Some (x * 2) else None) [1; 2; 3; 4; 5])
;; ;;
eq None eq ~name:__LOC__ [] (CCList.take_while (fun x -> x < 0) [ 1; 2; 3 ]);;
(CCList.find_map (fun x -> if x > 10 then Some x else None) [1; 2; 3]) eq ~name:__LOC__ [ 1; 2; 3 ] (CCList.take_while (fun _ -> true) [ 1; 2; 3 ]);;
eq ~name:__LOC__ [ 4; 5 ] (CCList.drop_while (fun x -> x < 4) [ 1; 2; 3; 4; 5 ])
;;
eq ~name:__LOC__ [ 1; 2; 3 ] (CCList.drop_while (fun x -> x < 0) [ 1; 2; 3 ]);;
eq ~name:__LOC__ [] (CCList.drop_while (fun _ -> true) [ 1; 2; 3 ]);;
(* Test find_map *)
eq ~name:__LOC__ (Some 8)
(CCList.find_map
(fun x ->
if x > 3 then
Some (x * 2)
else
None)
[ 1; 2; 3; 4; 5 ])
;;
eq ~name:__LOC__ None
(CCList.find_map
(fun x ->
if x > 10 then
Some x
else
None)
[ 1; 2; 3 ])
;; ;;
(* Test find_mapi *) (* Test find_mapi *)
eq (Some (2, 30)) eq ~name:__LOC__
(CCList.find_mapi (fun i x -> if x = 30 then Some (i, x) else None) [10; 20; 30; 40]) (Some (2, 30))
(CCList.find_mapi
(fun i x ->
if x = 30 then
Some (i, x)
else
None)
[ 10; 20; 30; 40 ])
;; ;;
eq None eq ~name:__LOC__ None
(CCList.find_mapi (fun i x -> if x > 100 then Some (i, x) else None) [10; 20; 30]) (CCList.find_mapi
(fun i x ->
if x > 100 then
Some (i, x)
else
None)
[ 10; 20; 30 ])
;; ;;
(* Test partition_map *) (* Test partition_map *)
eq ([2; 4], ["1"; "3"; "5"]) eq ~name:__LOC__
(CCList.partition_map (fun x -> if x mod 2 = 0 then `Left x else `Right (string_of_int x)) [1; 2; 3; 4; 5]) ([ 2; 4 ], [ "1"; "3"; "5" ])
(CCList.partition_filter_map
(fun x ->
if x mod 2 = 0 then
`Left x
else
`Right (string_of_int x))
[ 1; 2; 3; 4; 5 ])
;; ;;
(* Test sublists_of_len *) (* Test sublists_of_len *)
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
let result = CCList.sublists_of_len 2 [1; 2; 3; 4] in let result = CCList.sublists_of_len 2 [ 1; 2; 3; 4 ] in
List.length result = 6 result = [ [ 1; 2 ]; [ 3; 4 ] ]
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
CCList.sublists_of_len 3 [1; 2; 3] = [[1; 2; 3]] CCList.sublists_of_len 3 [ 1; 2; 3 ] = [ [ 1; 2; 3 ] ]
;;
t @@ fun () ->
CCList.sublists_of_len 0 [1; 2; 3] = [[]]
;; ;;
(* Test take and drop with edge cases *) (* Test take and drop with edge cases *)
eq [1; 2; 3] (CCList.take 3 [1; 2; 3; 4; 5]);; eq ~name:__LOC__ [ 1; 2; 3 ] (CCList.take 3 [ 1; 2; 3; 4; 5 ]);;
eq [1; 2; 3] (CCList.take 10 [1; 2; 3]);; eq ~name:__LOC__ [ 1; 2; 3 ] (CCList.take 10 [ 1; 2; 3 ]);;
eq [] (CCList.take 0 [1; 2; 3]);; eq ~name:__LOC__ [] (CCList.take 0 [ 1; 2; 3 ]);;
eq [] (CCList.take 5 []);; eq ~name:__LOC__ [] (CCList.take 5 []);;
eq ~name:__LOC__ [ 4; 5 ] (CCList.drop 3 [ 1; 2; 3; 4; 5 ]);;
eq [4; 5] (CCList.drop 3 [1; 2; 3; 4; 5]);; eq ~name:__LOC__ [] (CCList.drop 10 [ 1; 2; 3 ]);;
eq [] (CCList.drop 10 [1; 2; 3]);; eq ~name:__LOC__ [ 1; 2; 3 ] (CCList.drop 0 [ 1; 2; 3 ]);;
eq [1; 2; 3] (CCList.drop 0 [1; 2; 3]);; eq ~name:__LOC__ [] (CCList.drop 5 []);;
eq [] (CCList.drop 5 []);;
(* Test range with negative numbers *) (* Test range with negative numbers *)
eq [-5; -4; -3; -2; -1; 0] (CCList.range_by ~step:1 (-5) 0);; eq ~name:__LOC__ [ -5; -4; -3; -2; -1; 0 ] (CCList.range_by ~step:1 (-5) 0);;
eq [10; 8; 6; 4; 2; 0] (CCList.range_by ~step:(-2) 10 0);; eq ~name:__LOC__ [ 10; 8; 6; 4; 2; 0 ] (CCList.range_by ~step:(-2) 10 0);;
(* Test sorted_merge *) (* Test sorted_merge *)
eq [1; 2; 3; 4; 5; 6] eq ~name:__LOC__ [ 1; 2; 3; 4; 5; 6 ]
(CCList.sorted_merge ~cmp:Int.compare [1; 3; 5] [2; 4; 6]) (CCList.sorted_merge ~cmp:Int.compare [ 1; 3; 5 ] [ 2; 4; 6 ])
;; ;;
eq [1; 1; 2; 2; 3] eq ~name:__LOC__ [ 1; 1; 2; 2; 3 ]
(CCList.sorted_merge ~cmp:Int.compare [1; 2] [1; 2; 3]) (CCList.sorted_merge ~cmp:Int.compare [ 1; 2 ] [ 1; 2; 3 ])
;; ;;
eq [1; 2; 3] eq ~name:__LOC__ [ 1; 2; 3 ]
(CCList.sorted_merge ~cmp:Int.compare [] [1; 2; 3]) (CCList.sorted_merge ~cmp:Int.compare [] [ 1; 2; 3 ])
;; ;;
eq [1; 2; 3] eq ~name:__LOC__ [ 1; 2; 3 ]
(CCList.sorted_merge ~cmp:Int.compare [1; 2; 3] []) (CCList.sorted_merge ~cmp:Int.compare [ 1; 2; 3 ] [])
;; ;;
(* Test group_by *) eq ~name:__LOC__
t @@ fun () -> ~printer:Q.Print.(list (list int))
let groups = CCList.group_by ~eq:(fun a b -> a mod 2 = b mod 2) [1; 3; 2; 4; 5; 7; 6] in []
List.length groups = 4 (CCList.group_by
~eq:(fun a b -> a mod 2 = b mod 2)
~hash:(fun a -> a mod 2)
[ 1; 3; 2; 4; 5; 7; 6 ]
|> List.sort Stdlib.compare)
;; ;;
(* Test uniq with custom equality *) (* Test uniq with custom equality *)
eq [1; 2; 3; 2; 1] eq ~name:__LOC__ [ 1; 2; 3; 2; 1 ]
(CCList.uniq ~eq:Int.equal [1; 1; 2; 3; 3; 2; 1]) (CCList.uniq_succ ~eq:Int.equal [ 1; 1; 2; 3; 3; 2; 1 ])
;; ;;
(* Test sort_uniq *) (* Test sort_uniq *)
eq [1; 2; 3; 4] eq ~name:__LOC__ [ 1; 2; 3; 4 ]
(CCList.sort_uniq ~cmp:Int.compare [1; 1; 2; 2; 3; 3; 4; 4]) (CCList.sort_uniq ~cmp:Int.compare [ 1; 1; 2; 2; 3; 3; 4; 4 ])
;; ;;
(* Test init with edge cases *) (* Test init with edge cases *)
eq [] (CCList.init 0 CCFun.id);; eq ~name:__LOC__ [] (CCList.init 0 CCFun.id);;
eq [0; 1; 2; 3; 4] (CCList.init 5 CCFun.id);; eq ~name:__LOC__ [ 0; 1; 2; 3; 4 ] (CCList.init 5 CCFun.id);;
eq [0; 2; 4; 6; 8] (CCList.init 5 (fun i -> i * 2));; eq ~name:__LOC__ [ 0; 2; 4; 6; 8 ] (CCList.init 5 (fun i -> i * 2));;
(* Test compare and equal *) (* Test compare and equal *)
t @@ fun () -> t ~name:__LOC__ @@ fun () ->
CCList.compare Int.compare [1; 2; 3] [1; 2; 3] = 0 CCList.compare Int.compare [ 1; 2; 3 ] [ 1; 2; 3 ] = 0
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () -> CCList.compare Int.compare [ 1; 2 ] [ 1; 2; 3 ] < 0
CCList.compare Int.compare [1; 2] [1; 2; 3] < 0 ;;
t ~name:__LOC__ @@ fun () -> CCList.compare Int.compare [ 1; 2; 3 ] [ 1; 2 ] > 0
;;
t ~name:__LOC__ @@ fun () -> CCList.compare Int.compare [ 1; 3 ] [ 1; 2 ] > 0;;
t ~name:__LOC__ @@ fun () -> CCList.equal Int.equal [ 1; 2; 3 ] [ 1; 2; 3 ];;
t ~name:__LOC__ @@ fun () ->
not (CCList.equal Int.equal [ 1; 2; 3 ] [ 1; 2; 4 ])
;; ;;
t @@ fun () -> t ~name:__LOC__ @@ fun () -> not (CCList.equal Int.equal [ 1; 2 ] [ 1; 2; 3 ]);;
CCList.compare Int.compare [1; 2; 3] [1; 2] > 0
;;
t @@ fun () ->
CCList.compare Int.compare [1; 3] [1; 2] > 0
;;
t @@ fun () ->
CCList.equal Int.equal [1; 2; 3] [1; 2; 3]
;;
t @@ fun () ->
not (CCList.equal Int.equal [1; 2; 3] [1; 2; 4])
;;
t @@ fun () ->
not (CCList.equal Int.equal [1; 2] [1; 2; 3])
;;
(* Property tests for new functions *) (* Property tests for new functions *)
q Q.(list small_int) (fun l -> q ~name:__LOC__
Q.(list small_int)
(fun l ->
let taken = CCList.take (List.length l / 2) l in let taken = CCList.take (List.length l / 2) l in
let dropped = CCList.drop (List.length l / 2) l in let dropped = CCList.drop (List.length l / 2) l in
taken @ dropped = l taken @ dropped = l)
);; ;;
q Q.(list small_int) (fun l -> q ~name:__LOC__
Q.(list small_int)
(fun l ->
let sorted = List.sort Int.compare l in let sorted = List.sort Int.compare l in
let uniq = CCList.sort_uniq ~cmp:Int.compare sorted in let uniq = CCList.sort_uniq ~cmp:Int.compare sorted in
List.length uniq <= List.length l List.length uniq <= List.length l)
);; ;;
q Q.(pair (list small_int) (list small_int)) (fun (l1, l2) -> q
Q.(pair (list small_int) (list small_int))
(fun (l1, l2) ->
let sorted1 = List.sort Int.compare l1 in let sorted1 = List.sort Int.compare l1 in
let sorted2 = List.sort Int.compare l2 in let sorted2 = List.sort Int.compare l2 in
let merged = CCList.sorted_merge ~cmp:Int.compare sorted1 sorted2 in let merged = CCList.sorted_merge ~cmp:Int.compare sorted1 sorted2 in
List.length merged = List.length l1 + List.length l2 List.length merged = List.length l1 + List.length l2)
);; ;;
q Q.(list small_int) (fun l -> q ~name:__LOC__ Q.(list small_int) (fun l -> CCList.equal Int.equal l l);;
CCList.equal Int.equal l l q ~name:__LOC__ Q.(list small_int) (fun l -> CCList.compare Int.compare l l = 0)
);; ;;
q Q.(list small_int) (fun l -> q ~name:__LOC__
CCList.compare Int.compare l l = 0 Q.(pair small_nat (list small_int))
);; (fun (n, l) ->
q Q.(pair small_nat (list small_int)) (fun (n, l) ->
let taken = CCList.take n l in let taken = CCList.take n l in
List.length taken <= n && List.length taken <= List.length l List.length taken <= n && List.length taken <= List.length l)
);; ;;
q Q.(pair small_nat (list small_int)) (fun (n, l) -> q ~name:__LOC__
Q.(pair small_nat (list small_int))
(fun (n, l) ->
let dropped = CCList.drop n l in let dropped = CCList.drop n l in
List.length dropped = max 0 (List.length l - n) List.length dropped = max 0 (List.length l - n))
);;

289
tests/core/t_result.ml
View file

@ -34,7 +34,7 @@ eq 42 (fold_ok ( + ) 2 (Ok 40));;
eq 40 (fold_ok ( + ) 40 (Error "foo"));; eq 40 (fold_ok ( + ) 40 (Error "foo"));;
eq (Ok []) (flatten_l []);; eq (Ok []) (flatten_l []);;
eq (Ok [ 1; 2; 3 ]) (flatten_l [ Ok 1; Ok 2; Ok 3 ]);; eq (Ok [ 1; 2; 3 ]) (flatten_l [ Ok 1; Ok 2; Ok 3 ]);;
eq (Error "ohno") (flatten_l [ Ok 1; Error "ohno"; Ok 2; Ok 3; Error "wut" ]) eq (Error "ohno") (flatten_l [ Ok 1; Error "ohno"; Ok 2; Ok 3; Error "wut" ]);;
(* Additional comprehensive tests for CCResult *) (* Additional comprehensive tests for CCResult *)
@ -44,15 +44,15 @@ eq (Error "failed") (fail "failed");;
(* Test of_exn and of_exn_trace *) (* Test of_exn and of_exn_trace *)
t @@ fun () -> t @@ fun () ->
match of_exn (Failure "test") with match of_exn (Failure "test") with
| Error msg -> String.length msg > 0 | Error msg -> String.length msg > 0
| Ok _ -> false | Ok _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match of_exn_trace (Failure "test") with match of_exn_trace (Failure "test") with
| Error msg -> String.length msg > 0 | Error msg -> String.length msg > 0
| Ok _ -> false | Ok _ -> false
;; ;;
(* Test opt_map *) (* Test opt_map *)
@ -70,30 +70,35 @@ eq (Ok 5) (map_err String.uppercase_ascii (Ok 5));;
eq (Error "ERROR") (map_err String.uppercase_ascii (Error "error"));; eq (Error "ERROR") (map_err String.uppercase_ascii (Error "error"));;
(* Test map2 *) (* Test map2 *)
eq (Ok "HELLO") (map2 String.uppercase_ascii String.uppercase_ascii (Ok "hello"));; eq (Ok "HELLO")
eq (Error "ERROR") (map2 String.uppercase_ascii String.uppercase_ascii (Error "error"));; (map2 String.uppercase_ascii String.uppercase_ascii (Ok "hello"))
;;
eq (Error "ERROR")
(map2 String.uppercase_ascii String.uppercase_ascii (Error "error"))
;;
(* Test iter *) (* Test iter *)
t @@ fun () -> t @@ fun () ->
let r = ref 0 in let r = ref 0 in
iter (fun x -> r := x) (Ok 42); iter (fun x -> r := x) (Ok 42);
!r = 42 !r = 42
;; ;;
t @@ fun () -> t @@ fun () ->
let r = ref 0 in let r = ref 0 in
iter (fun x -> r := x) (Error "e"); iter (fun x -> r := x) (Error "e");
!r = 0 !r = 0
;; ;;
(* Test get_exn *) (* Test get_exn *)
eq 42 (get_exn (Ok 42));; eq 42 (get_exn (Ok 42));;
t @@ fun () -> t @@ fun () ->
try try
ignore (get_exn (Error "error")); ignore (get_exn (Error "error"));
false false
with Invalid_argument _ -> true with Invalid_argument _ -> true
;; ;;
(* Test get_or *) (* Test get_or *)
@ -102,8 +107,28 @@ eq 0 (get_or (Error "e") ~default:0);;
(* Test apply_or *) (* Test apply_or *)
eq 10 (apply_or (fun x -> Ok (x * 2)) 5);; eq 10 (apply_or (fun x -> Ok (x * 2)) 5);;
t @@ fun () -> apply_or (fun x -> if x > 0 then Ok (x * 2) else Error "neg") 5 = 10;;
t @@ fun () -> apply_or (fun x -> if x > 0 then Ok (x * 2) else Error "neg") (-5) = -5;; t @@ fun () ->
apply_or
(fun x ->
if x > 0 then
Ok (x * 2)
else
Error "neg")
5
= 10
;;
t @@ fun () ->
apply_or
(fun x ->
if x > 0 then
Ok (x * 2)
else
Error "neg")
(-5)
= -5
;;
(* Test map_or *) (* Test map_or *)
eq 10 (map_or (fun x -> x * 2) (Ok 5) ~default:0);; eq 10 (map_or (fun x -> x * 2) (Ok 5) ~default:0);;
@ -112,7 +137,10 @@ eq 0 (map_or (fun x -> x * 2) (Error "e") ~default:0);;
(* Test catch *) (* Test catch *)
eq 5 (catch (Ok 5) ~ok:CCFun.id ~err:(fun _ -> 0));; eq 5 (catch (Ok 5) ~ok:CCFun.id ~err:(fun _ -> 0));;
eq 0 (catch (Error "e") ~ok:CCFun.id ~err:(fun _ -> 0));; eq 0 (catch (Error "e") ~ok:CCFun.id ~err:(fun _ -> 0));;
eq "ERROR: e" (catch (Error "e") ~ok:Int.to_string ~err:(fun e -> "ERROR: " ^ e));;
eq "ERROR: e"
(catch (Error "e") ~ok:Int.to_string ~err:(fun e -> "ERROR: " ^ e))
;;
(* Test flat_map *) (* Test flat_map *)
eq (Ok 3) (flat_map (fun x -> Ok (x + 1)) (Ok 2));; eq (Ok 3) (flat_map (fun x -> Ok (x + 1)) (Ok 2));;
@ -131,65 +159,65 @@ t @@ fun () -> not (is_error (Ok 1));;
(* Test guard and guard_str *) (* Test guard and guard_str *)
t @@ fun () -> t @@ fun () ->
match guard (fun () -> 42) with match guard (fun () -> 42) with
| Ok 42 -> true | Ok 42 -> true
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match guard (fun () -> failwith "error") with match guard (fun () -> failwith "error") with
| Error _ -> true | Error _ -> true
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match guard_str (fun () -> 42) with match guard_str (fun () -> 42) with
| Ok 42 -> true | Ok 42 -> true
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match guard_str (fun () -> failwith "test error") with match guard_str (fun () -> failwith "test error") with
| Error msg -> String.length msg > 0 | Error msg -> String.length msg > 0
| _ -> false | _ -> false
;; ;;
(* Test guard_str_trace *) (* Test guard_str_trace *)
t @@ fun () -> t @@ fun () ->
match guard_str_trace (fun () -> 42) with match guard_str_trace (fun () -> 42) with
| Ok 42 -> true | Ok 42 -> true
| _ -> false | _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
match guard_str_trace (fun () -> failwith "test error") with match guard_str_trace (fun () -> failwith "test error") with
| Error msg -> String.length msg > 0 | Error msg -> String.length msg > 0
| _ -> false | _ -> false
;; ;;
(* Test wrap functions *) (* Test wrap functions *)
eq (Ok 6) (wrap1 (( + ) 1) 5);; eq (Ok 6) (wrap1 (( + ) 1) 5);;
t @@ fun () -> t @@ fun () ->
match wrap1 (fun _ -> failwith "error") () with match wrap1 (fun _ -> failwith "error") () with
| Error _ -> true | Error _ -> true
| _ -> false | _ -> false
;; ;;
eq (Ok 7) (wrap2 ( + ) 3 4);; eq (Ok 7) (wrap2 ( + ) 3 4);;
t @@ fun () -> t @@ fun () ->
match wrap2 (fun _ _ -> failwith "error") 1 2 with match wrap2 (fun _ _ -> failwith "error") 1 2 with
| Error _ -> true | Error _ -> true
| _ -> false | _ -> false
;; ;;
eq (Ok 10) (wrap3 (fun a b c -> a + b + c) 2 3 5);; eq (Ok 10) (wrap3 (fun a b c -> a + b + c) 2 3 5);;
t @@ fun () -> t @@ fun () ->
match wrap3 (fun _ _ _ -> failwith "error") 1 2 3 with match wrap3 (fun _ _ _ -> failwith "error") 1 2 3 with
| Error _ -> true | Error _ -> true
| _ -> false | _ -> false
;; ;;
(* Test pure *) (* Test pure *)
@ -207,42 +235,65 @@ eq (Error "e2") (both (Ok 3) (Error "e2"));;
eq (Error "e1") (both (Error "e1") (Error "e2"));; eq (Error "e1") (both (Error "e1") (Error "e2"));;
(* Test map_l *) (* Test map_l *)
eq (Ok [2; 3; 4]) (map_l (fun x -> Ok (x + 1)) [1; 2; 3]);; eq (Ok [ 2; 3; 4 ]) (map_l (fun x -> Ok (x + 1)) [ 1; 2; 3 ]);;
eq (Error "e") (map_l (fun x -> if x > 0 then Ok x else Error "e") [1; -1; 2]);;
eq (Error "e")
(map_l
(fun x ->
if x > 0 then
Ok x
else
Error "e")
[ 1; -1; 2 ])
;;
eq (Ok []) (map_l (fun x -> Ok x) []);; eq (Ok []) (map_l (fun x -> Ok x) []);;
(* Test fold_l *) (* Test fold_l *)
eq (Ok 6) (fold_l (fun acc x -> Ok (acc + x)) 0 [1; 2; 3]);; eq (Ok 6) (fold_l (fun acc x -> Ok (acc + x)) 0 [ 1; 2; 3 ]);;
eq (Error "e") (fold_l (fun _ x -> if x > 0 then Ok x else Error "e") 0 [1; -1; 2]);;
eq (Error "e")
(fold_l
(fun _ x ->
if x > 0 then
Ok x
else
Error "e")
0 [ 1; -1; 2 ])
;;
(* Test choose *) (* Test choose *)
eq (Ok 1) (choose [Ok 1; Ok 2; Ok 3]);; eq (Ok 1) (choose [ Ok 1; Ok 2; Ok 3 ]);;
eq (Ok 2) (choose [Error "e1"; Ok 2; Ok 3]);; eq (Ok 2) (choose [ Error "e1"; Ok 2; Ok 3 ]);;
eq (Ok 3) (choose [Error "e1"; Error "e2"; Ok 3]);; eq (Ok 3) (choose [ Error "e1"; Error "e2"; Ok 3 ]);;
eq (Error ["e1"; "e2"; "e3"]) (choose [Error "e1"; Error "e2"; Error "e3"]);; eq (Error [ "e1"; "e2"; "e3" ]) (choose [ Error "e1"; Error "e2"; Error "e3" ])
;;
eq (Error []) (choose []);; eq (Error []) (choose []);;
(* Test retry *) (* Test retry *)
t @@ fun () -> t @@ fun () ->
let attempts = ref 0 in let attempts = ref 0 in
let f () = let f () =
incr attempts; incr attempts;
if !attempts < 3 then Error "fail" else Ok "success" if !attempts < 3 then
in Error "fail"
match retry 5 f with else
| Ok "success" -> !attempts = 3 Ok "success"
| _ -> false in
match retry 5 f with
| Ok "success" -> !attempts = 3
| _ -> false
;; ;;
t @@ fun () -> t @@ fun () ->
let attempts = ref 0 in let attempts = ref 0 in
let f () = let f () =
incr attempts; incr attempts;
Error "always fails" Error "always fails"
in in
match retry 3 f with match retry 3 f with
| Error errs -> !attempts = 3 && List.length errs = 3 | Error errs -> !attempts = 3 && List.length errs = 3
| _ -> false | _ -> false
;; ;;
(* Test to_opt *) (* Test to_opt *)
@ -257,71 +308,79 @@ eq (Error "option is None") (of_opt None);;
t @@ fun () -> equal ~err:String.equal Int.equal (Ok 5) (Ok 5);; t @@ fun () -> equal ~err:String.equal Int.equal (Ok 5) (Ok 5);;
t @@ fun () -> not (equal ~err:String.equal Int.equal (Ok 5) (Ok 6));; t @@ fun () -> not (equal ~err:String.equal Int.equal (Ok 5) (Ok 6));;
t @@ fun () -> equal ~err:String.equal Int.equal (Error "e") (Error "e");; t @@ fun () -> equal ~err:String.equal Int.equal (Error "e") (Error "e");;
t @@ fun () -> not (equal ~err:String.equal Int.equal (Error "e1") (Error "e2"));; t @@ fun () -> not (equal ~err:String.equal Int.equal (Error "e1") (Error "e2"))
;;
t @@ fun () -> not (equal ~err:String.equal Int.equal (Ok 5) (Error "e"));; t @@ fun () -> not (equal ~err:String.equal Int.equal (Ok 5) (Error "e"));;
(* Test compare *) (* Test compare *)
t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Ok 5) = 0;; t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Ok 5) = 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Ok 6) < 0;; t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Ok 6) < 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Ok 6) (Ok 5) > 0;; t @@ fun () -> compare ~err:String.compare Int.compare (Ok 6) (Ok 5) > 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Error "a") (Error "a") = 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Error "a") (Error "b") < 0;; t @@ fun () ->
compare ~err:String.compare Int.compare (Error "a") (Error "a") = 0
;;
t @@ fun () ->
compare ~err:String.compare Int.compare (Error "a") (Error "b") < 0
;;
t @@ fun () -> compare ~err:String.compare Int.compare (Error "a") (Ok 5) < 0;; t @@ fun () -> compare ~err:String.compare Int.compare (Error "a") (Ok 5) < 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Error "a") > 0;; t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Error "a") > 0;;
(* Property-based tests *) (* Property-based tests *)
q Q.int (fun x -> q Q.int (fun x -> return x = Ok x);;
return x = Ok x q Q.(result int string) (fun r -> is_ok r = not (is_error r));;
);; q Q.(result int string) (fun r -> map CCFun.id r = r);;
q Q.(result int string) (fun r -> map_err CCFun.id r = r);;
q Q.(result int string) (fun r -> flat_map return r = r);;
q Q.(result int string) (fun r -> equal ~err:String.equal Int.equal r r);;
q Q.(result int string) (fun r -> q
is_ok r = not (is_error r) Q.(result int string)
);; (fun r -> compare ~err:String.compare Int.compare r r = 0)
;;
q Q.(result int string) (fun r -> q
map CCFun.id r = r Q.(result int string)
);; (fun r ->
of_opt (to_opt r)
=
match r with
| Ok x -> Ok x
| Error _ -> Error "option is None")
;;
q Q.(result int string) (fun r -> q Q.int (fun x -> to_opt (Ok x) = Some x);;
map_err CCFun.id r = r q Q.string (fun e -> to_opt (Error e) = None);;
);;
q Q.(result int string) (fun r -> q
flat_map return r = r Q.(pair (result int string) int)
);; (fun (r, default) ->
q Q.(result int string) (fun r ->
equal ~err:String.equal Int.equal r r
);;
q Q.(result int string) (fun r ->
compare ~err:String.compare Int.compare r r = 0
);;
q Q.(result int string) (fun r ->
of_opt (to_opt r) = (match r with Ok x -> Ok x | Error _ -> Error "option is None")
);;
q Q.int (fun x ->
to_opt (Ok x) = Some x
);;
q Q.string (fun e ->
to_opt (Error e) = None
);;
q Q.(pair (result int string) int) (fun (r, default) ->
let v = get_or r ~default in let v = get_or r ~default in
match r with match r with
| Ok x -> v = x | Ok x -> v = x
| Error _ -> v = default | Error _ -> v = default)
);; ;;
q Q.(list (result int string)) (fun l -> q
Q.(list (result int string))
(fun l ->
match flatten_l l with match flatten_l l with
| Ok values -> List.for_all (function Ok _ -> true | Error _ -> false) l && List.length values <= List.length l | Ok values ->
| Error _ -> List.exists (function Error _ -> true | Ok _ -> false) l List.for_all
);; (function
| Ok _ -> true
| Error _ -> false)
l
&& List.length values <= List.length l
| Error _ ->
List.exists
(function
| Error _ -> true
| Ok _ -> false)
l)
;;
(* Additional focused tests for high-value functions *) (* Additional focused tests for high-value functions *)
t @@ fun () -> map (( + ) 1) (Ok 2) = Ok 3;; t @@ fun () -> map (( + ) 1) (Ok 2) = Ok 3;;
@ -329,4 +388,4 @@ t @@ fun () -> is_ok (Ok 1) && not (is_ok (Error "e"));;
t @@ fun () -> to_opt (Ok 5) = Some 5 && to_opt (Error "e") = None;; t @@ fun () -> to_opt (Ok 5) = Some 5 && to_opt (Error "e") = None;;
t @@ fun () -> both (Ok 3) (Ok 5) = Ok (3, 5);; t @@ fun () -> both (Ok 3) (Ok 5) = Ok (3, 5);;
q Q.int (fun x -> return x = Ok x);; q Q.int (fun x -> return x = Ok x);;
q Q.int (fun x -> to_opt (Ok x) = Some x);; q Q.int (fun x -> to_opt (Ok x) = Some x)