Compare commits

...

3 commits

Author SHA1 Message Date
Simon Cruanes
7ec6485ab4
wip 2026-02-11 20:18:41 -05:00
Simon Cruanes
84c3270718
more tests 2026-02-11 20:18:41 -05:00
Simon Cruanes
df7619786c
prepare for 3.18
Some checks failed
format / format (push) Has been cancelled
Build and Test / build (push) Has been cancelled
2026-02-10 21:08:02 -05:00
17 changed files with 1808 additions and 23 deletions

5
.gitignore vendored
View file

@ -16,3 +16,8 @@ fuzz-*-input
fuzz-*-output
fuzz-logs/
doc/papers
# Coverage files
_coverage/
*.coverage
bisect*.coverage

View file

@ -1,10 +1,15 @@
## main
- breaking: CCListLabel.compare and CCListLabel.equal takes the function on the elements as named arguments
- breaking: CCListLabel.init now takes the length as a named arguments to follow the Stdlib
- breaking: change the semantic of CCFloat.{min,max} with respect to NaN to follow the Stdlib
- breaking: change the semantic of CCInt.rem with respect to negative number to follow the Stdlib
- breaking: change the order of argument of CCMap.add_seq to align with the stdlib.
## 3.18
- fix leb128 slice bug
- fix leb128 `Int64.min_int` bug
- add tests for leb128 library (#486)
- some breaking changes after the big bump to 4.08 as lower bound, thanks to @fardale for the cleanup
* breaking: CCListLabel.compare and CCListLabel.equal takes the function on the elements as named arguments
* breaking: CCListLabel.init now takes the length as a named arguments to follow the Stdlib
* breaking: change the semantic of CCFloat.{min,max} with respect to NaN to follow the Stdlib
* breaking: change the semantic of CCInt.rem with respect to negative number to follow the Stdlib
* breaking: change the order of argument of `CCMap.add_seq` to align with the stdlib.
## 3.17

View file

@ -1,6 +1,6 @@
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
version: "3.17"
version: "3.18"
synopsis: "A set of advanced datatypes for containers"
maintainer: ["c-cube"]
authors: ["c-cube"]

View file

@ -1,6 +1,6 @@
# This file is generated by dune, edit dune-project instead
opam-version: "2.0"
version: "3.17"
version: "3.18"
synopsis:
"A modular, clean and powerful extension of the OCaml standard library"
maintainer: ["c-cube"]

View file

@ -4,7 +4,7 @@
(generate_opam_files true)
(version 3.17)
(version 3.18)
(authors c-cube)

View file

@ -1,7 +1,5 @@
(library
(name containers_cbor)
(libraries containers)
(preprocess
(action
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
(instrumentation (backend bisect_ppx))
(public_name containers.cbor))

View file

@ -104,7 +104,7 @@ val option : ?none:unit printer -> 'a printer -> 'a option printer
- [Some x] will become [pp x]
- [None] will become [none ()]
Alias of {!Format.pp_print_option}
@since NEXT_RELEASE *)
@since 3.18 *)
val opt : 'a printer -> 'a option printer
(** [opt pp] prints options as follows:

View file

@ -49,7 +49,7 @@ val forever : (unit -> 'a) -> 'a t
val cycle : 'a t -> 'a t
(** Cycle through the sequence infinitely. The sequence should be persistent.
@since NEXT_RELEASE the sequence can be empty, in this case cycle return an empty sequence. *)
@since 3.18 the sequence can be empty, in this case cycle return an empty sequence. *)
val iterate : ('a -> 'a) -> 'a -> 'a t
(** [iterate f a] corresponds to the infinite sequence containing [a], [f a], [f (f a)],

View file

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

View file

@ -5,6 +5,7 @@ Containers_testlib.run_all ~descr:"containers"
T_array.get ();
T_bool.get ();
T_byte_buffer.get ();
T_byte_slice.get ();
T_canonical_sexp.get ();
T_char.get ();
T_either.get ();
@ -23,8 +24,10 @@ Containers_testlib.run_all ~descr:"containers"
T_nativeint.get ();
T_option.get ();
T_ord.get ();
T_pair.get ();
T_parse.get ();
T_random.get ();
T_ref.get ();
T_result.get ();
T_set.get ();
T_seq.get ();

197
tests/core/t_byte_slice.ml Normal file
View file

@ -0,0 +1,197 @@
module T = (val Containers_testlib.make ~__FILE__ ())
include T
open CCByte_slice;;
t @@ fun () ->
let bs = Bytes.of_string "hello" in
let sl = create bs in
len sl = 5
;;
t @@ fun () ->
let bs = Bytes.of_string "hello world" in
let sl = create ~off:6 bs in
len sl = 5
;;
t @@ fun () ->
let bs = Bytes.of_string "hello world" in
let sl = create ~off:6 ~len:3 bs in
len sl = 3
;;
(* Test unsafe_of_string *)
t @@ fun () ->
let sl = unsafe_of_string "hello" in
len sl = 5
;;
t @@ fun () ->
let sl = unsafe_of_string ~off:2 ~len:3 "hello" in
len sl = 3
;;
(* Test len *)
eq 5 (len (create (Bytes.of_string "hello")));;
eq 0 (len (create ~len:0 (Bytes.of_string "hello")));;
eq 3 (len (create ~off:2 ~len:3 (Bytes.of_string "hello")));;
(* Test get *)
t @@ fun () ->
let sl = create (Bytes.of_string "hello") in
get sl 0 = 'h' && get sl 4 = 'o'
;;
t @@ fun () ->
let sl = create ~off:2 ~len:3 (Bytes.of_string "hello") in
get sl 0 = 'l' && get sl 2 = 'o'
;;
t @@ fun () ->
let sl = unsafe_of_string "world" in
get sl 0 = 'w' && get sl 4 = 'd'
;;
(* Test get out of bounds *)
t @@ fun () ->
let sl = create (Bytes.of_string "hi") in
try
ignore (get sl 2);
false
with Invalid_argument _ -> true
;;
t @@ fun () ->
let sl = create (Bytes.of_string "hi") in
try
ignore (get sl (-1));
false
with Invalid_argument _ -> true
;;
(* Test set *)
t @@ fun () ->
let bs = Bytes.of_string "hello" in
let sl = create bs in
set sl 0 'H';
get sl 0 = 'H' && Bytes.get bs 0 = 'H'
;;
t @@ fun () ->
let bs = Bytes.of_string "hello world" in
let sl = create ~off:6 ~len:5 bs in
set sl 0 'W';
get sl 0 = 'W' && Bytes.get bs 6 = 'W'
;;
(* Test set out of bounds *)
t @@ fun () ->
let sl = create (Bytes.of_string "hi") in
try
set sl 2 'x';
false
with Invalid_argument _ -> true
;;
(* Test consume *)
t @@ fun () ->
let bs = Bytes.of_string "hello" in
let sl = create bs in
consume sl 2;
len sl = 3 && get sl 0 = 'l'
;;
t @@ fun () ->
let bs = Bytes.of_string "hello world" in
let sl = create ~off:0 ~len:5 bs in
consume sl 2;
len sl = 3 && get sl 0 = 'l' && sl.off = 2
;;
t @@ fun () ->
let bs = Bytes.of_string "test" in
let sl = create bs in
consume sl 4;
len sl = 0
;;
(* Test contents *)
eq "hello" (contents (create (Bytes.of_string "hello")));;
eq "world" (contents (create ~off:6 (Bytes.of_string "hello world")));;
eq "ell" (contents (create ~off:1 ~len:3 (Bytes.of_string "hello")));;
t @@ fun () ->
let bs = Bytes.of_string "hello" in
let sl = create bs in
let c = contents sl in
(* Modifying the slice should not affect the returned string *)
set sl 0 'H';
c = "hello"
;;
t @@ fun () ->
let sl = create (Bytes.of_string "test") in
consume sl 2;
contents sl = "st"
;;
(* Test sub *)
t @@ fun () ->
let bs = Bytes.of_string "hello world" in
let sl = create bs in
let sub_sl = sub sl 0 5 in
len sub_sl = 5 && get sub_sl 0 = 'h'
;;
t @@ fun () ->
let bs = Bytes.of_string "hello world" in
let sl = create bs in
let sub_sl = sub sl 6 5 in
len sub_sl = 5 && get sub_sl 0 = 'w'
;;
t @@ fun () ->
let bs = Bytes.of_string "hello world" in
let sl = create ~off:6 ~len:5 bs in
let sub_sl = sub sl 0 3 in
len sub_sl = 3 && get sub_sl 0 = 'w' && contents sub_sl = "wor"
;;
(* Test that sub shares the underlying bytes *)
t @@ fun () ->
let bs = Bytes.of_string "hello" in
let sl = create bs in
let sub_sl = sub sl 1 3 in
set sub_sl 0 'E';
get sl 1 = 'E'
;;
(* Property-based tests *)
q Q.(string_of_size (Gen.int_range 1 100)) (fun s ->
let bs = Bytes.of_string s in
let sl = create bs in
contents sl = s
);;
q Q.(string_of_size (Gen.int_range 1 100)) (fun s ->
let bs = Bytes.of_string s in
let sl = create bs in
len sl = String.length s
);;
q Q.(pair (string_of_size (Gen.int_range 5 100)) small_nat) (fun (s, n) ->
let bs = Bytes.of_string s in
let sl = create bs in
let n = min n (len sl) in
consume sl n;
len sl = String.length s - n
);;
q Q.(string_of_size (Gen.int_range 10 100)) (fun s ->
let bs = Bytes.of_string s in
let sl = create bs in
let mid = String.length s / 2 in
let sub1 = sub sl 0 mid in
let sub2 = sub sl mid (String.length s - mid) in
contents sub1 ^ contents sub2 = s
);;

View file

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

View file

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

View file

@ -27,4 +27,306 @@ t @@ fun () -> flatten None = None;;
t @@ fun () -> flatten (Some None) = None;;
t @@ fun () -> flatten (Some (Some 1)) = Some 1;;
t @@ fun () -> return_if false 1 = None;;
t @@ fun () -> return_if true 1 = Some 1
t @@ fun () -> return_if true 1 = Some 1;;
(* Additional comprehensive tests for CCOption *)
(* Test map *)
eq (Some 2) (map (( + ) 1) (Some 1));;
eq None (map (( + ) 1) None);;
t @@ fun () -> map (fun x -> x * 2) (Some 5) = Some 10;;
(* Test map_or *)
eq 10 (map_or ~default:0 (fun x -> x * 2) (Some 5));;
eq 0 (map_or ~default:0 (fun x -> x * 2) None);;
t @@ fun () -> map_or ~default:"empty" String.uppercase_ascii (Some "hello") = "HELLO";;
t @@ fun () -> map_or ~default:"empty" String.uppercase_ascii None = "empty";;
(* Test map_lazy *)
t @@ fun () ->
let called = ref false in
let result = map_lazy (fun () -> called := true; 0) (fun x -> x * 2) (Some 5) in
result = 10 && not !called
;;
t @@ fun () ->
let called = ref false in
let result = map_lazy (fun () -> called := true; 0) (fun x -> x * 2) None in
result = 0 && !called
;;
(* Test is_some and is_none *)
t @@ fun () -> is_some (Some 1);;
t @@ fun () -> not (is_some None);;
t @@ fun () -> is_none None;;
t @@ fun () -> not (is_none (Some 1));;
(* Test compare *)
t @@ fun () -> compare Int.compare (Some 1) (Some 1) = 0;;
t @@ fun () -> compare Int.compare (Some 1) (Some 2) < 0;;
t @@ fun () -> compare Int.compare (Some 2) (Some 1) > 0;;
t @@ fun () -> compare Int.compare None None = 0;;
t @@ fun () -> compare Int.compare None (Some 1) < 0;;
t @@ fun () -> compare Int.compare (Some 1) None > 0;;
(* Test equal *)
t @@ fun () -> equal Int.equal (Some 1) (Some 1);;
t @@ fun () -> not (equal Int.equal (Some 1) (Some 2));;
t @@ fun () -> equal Int.equal None None;;
t @@ fun () -> not (equal Int.equal None (Some 1));;
t @@ fun () -> not (equal Int.equal (Some 1) None);;
(* Test return and some *)
eq (Some 42) (return 42);;
eq (Some "hello") (some "hello");;
t @@ fun () -> return 5 = Some 5;;
(* Test none *)
t @@ fun () -> (none : int option) = None;;
(* Test flat_map / bind *)
eq (Some 2) (flat_map (fun x -> Some (x + 1)) (Some 1));;
eq None (flat_map (fun x -> Some (x + 1)) None);;
eq None (flat_map (fun _ -> None) (Some 1));;
eq (Some 2) (bind (Some 1) (fun x -> Some (x + 1)));;
eq None (bind None (fun x -> Some (x + 1)));;
(* Test flat_map_l *)
eq [1; 2; 3] (flat_map_l (fun x -> [x; x+1; x+2]) (Some 1));;
eq [] (flat_map_l (fun x -> [x; x+1]) None);;
(* Test map2 *)
eq (Some 5) (map2 ( + ) (Some 2) (Some 3));;
eq None (map2 ( + ) None (Some 3));;
eq None (map2 ( + ) (Some 2) None);;
eq None (map2 ( + ) None None);;
(* Test iter *)
t @@ fun () ->
let r = ref 0 in
iter (fun x -> r := x) (Some 42);
!r = 42
;;
t @@ fun () ->
let r = ref 0 in
iter (fun x -> r := x) None;
!r = 0
;;
(* Test fold *)
eq 10 (fold (fun acc x -> acc + x) 5 (Some 5));;
eq 5 (fold (fun acc x -> acc + x) 5 None);;
(* Test if_ *)
eq (Some 5) (if_ (fun x -> x > 0) 5);;
eq None (if_ (fun x -> x > 0) (-5));;
eq (Some "hello") (if_ (fun s -> String.length s > 0) "hello");;
eq None (if_ (fun s -> String.length s > 0) "");;
(* Test exists *)
t @@ fun () -> exists (fun x -> x > 0) (Some 5);;
t @@ fun () -> not (exists (fun x -> x > 0) (Some (-5)));;
t @@ fun () -> not (exists (fun x -> x > 0) None);;
(* Test for_all *)
t @@ fun () -> for_all (fun x -> x > 0) (Some 5);;
t @@ fun () -> not (for_all (fun x -> x > 0) (Some (-5)));;
t @@ fun () -> for_all (fun x -> x > 0) None;;
(* Test get_or *)
eq 5 (get_or ~default:0 (Some 5));;
eq 0 (get_or ~default:0 None);;
(* Test value *)
eq 5 (value (Some 5) ~default:0);;
eq 0 (value None ~default:0);;
(* Test apply_or *)
eq 10 (apply_or (fun x -> Some (x * 2)) 5);;
t @@ fun () -> apply_or (fun x -> if x > 0 then Some (x * 2) else None) 5 = 10;;
t @@ fun () -> apply_or (fun x -> if x > 0 then Some (x * 2) else None) (-5) = -5;;
(* Test get_exn *)
eq 42 (get_exn (Some 42));;
t @@ fun () ->
try
ignore (get_exn None);
false
with Invalid_argument _ -> true
;;
(* Test get_lazy *)
eq 5 (get_lazy (fun () -> 0) (Some 5));;
eq 0 (get_lazy (fun () -> 0) None);;
t @@ fun () ->
let called = ref false in
let _ = get_lazy (fun () -> called := true; 0) (Some 5) in
not !called
;;
t @@ fun () ->
let called = ref false in
let _ = get_lazy (fun () -> called := true; 0) None in
!called
;;
(* Test wrap *)
t @@ fun () ->
wrap (fun x -> x + 1) 5 = Some 6
;;
t @@ fun () ->
wrap (fun _ -> failwith "error") () = None
;;
t @@ fun () ->
wrap ~handler:(fun _ -> true) (fun x -> if x = 0 then failwith "div by zero" else 10 / x) 0 = None
;;
t @@ fun () ->
wrap ~handler:(function Division_by_zero -> true | _ -> false)
(fun x -> 10 / x) 2 = Some 5
;;
(* Test wrap2 *)
t @@ fun () ->
wrap2 ( + ) 2 3 = Some 5
;;
t @@ fun () ->
wrap2 (fun _ _ -> failwith "error") 1 2 = None
;;
(* Test pure *)
eq (Some 42) (pure 42);;
(* Test or_ *)
eq (Some 1) (or_ ~else_:(Some 2) (Some 1));;
eq (Some 2) (or_ ~else_:(Some 2) None);;
eq None (or_ ~else_:None None);;
(* Test or_lazy *)
t @@ fun () ->
let called = ref false in
let result = or_lazy ~else_:(fun () -> called := true; Some 2) (Some 1) in
result = Some 1 && not !called
;;
t @@ fun () ->
let called = ref false in
let result = or_lazy ~else_:(fun () -> called := true; Some 2) None in
result = Some 2 && !called
;;
(* Test choice *)
eq (Some 1) (choice [Some 1; Some 2; Some 3]);;
eq (Some 2) (choice [None; Some 2; Some 3]);;
eq (Some 3) (choice [None; None; Some 3]);;
eq None (choice [None; None; None]);;
eq None (choice []);;
(* Test to_list *)
eq [42] (to_list (Some 42));;
eq [] (to_list None);;
(* Test of_list *)
eq (Some 1) (of_list [1]);;
eq (Some 1) (of_list [1; 2; 3]);;
eq None (of_list []);;
(* Test to_result *)
eq (Ok 5) (to_result "error" (Some 5));;
eq (Error "error") (to_result "error" None);;
(* Test to_result_lazy *)
t @@ fun () ->
let called = ref false in
let result = to_result_lazy (fun () -> called := true; "error") (Some 5) in
result = Ok 5 && not !called
;;
t @@ fun () ->
let called = ref false in
let result = to_result_lazy (fun () -> called := true; "error") None in
result = Error "error" && !called
;;
(* Test of_result *)
eq (Some 5) (of_result (Ok 5));;
eq None (of_result (Error "error"));;
(* Property-based tests *)
q Q.int (fun x ->
return x = Some x
);;
q Q.(option int) (fun o ->
is_some o = not (is_none o)
);;
q Q.(option int) (fun o ->
map CCFun.id o = o
);;
q Q.(option int) (fun o ->
flat_map return o = o
);;
q Q.(option int) (fun o ->
bind o return = o
);;
q Q.(option int) (fun o ->
equal Int.equal o o
);;
q Q.(option int) (fun o ->
compare Int.compare o o = 0
);;
q Q.(pair (option int) int) (fun (o, default) ->
let v = get_or ~default o in
match o with
| Some x -> v = x
| None -> v = default
);;
q Q.int (fun x ->
to_list (Some x) = [x]
);;
q Q.(list int) (fun l ->
match of_list l with
| Some x -> List.mem x l
| None -> l = []
);;
q Q.(option int) (fun o ->
match o with
| Some x -> of_list (to_list o) = Some x
| None -> of_list (to_list o) = None
);;
q Q.(option int) (fun o ->
of_result (to_result "err" o) = o
);;
q Q.int (fun x ->
let o1 = Some x in
let o2 = Some x in
or_ ~else_:o2 o1 = o1
);;
q Q.int (fun x ->
or_ ~else_:(Some x) None = Some x
);;
q Q.(pair (option int) (option int)) (fun (o1, o2) ->
match choice [o1; o2] with
| Some _ -> is_some o1 || is_some o2
| None -> is_none o1 && is_none o2
);;

139
tests/core/t_pair.ml Normal file
View file

@ -0,0 +1,139 @@
open CCPair
module T = (val Containers_testlib.make ~__FILE__ ())
include T;;
t @@ fun () -> make 1 2 = (1, 2);;
t @@ fun () -> fst (make 'a' 'b') = 'a';;
t @@ fun () -> snd (make 'a' 'b') = 'b';;
(* Test map_fst *)
eq (2, "hello") (map_fst (( + ) 1) (1, "hello"));;
eq ('B', 5) (map_fst Char.uppercase_ascii ('b', 5));;
t @@ fun () -> map_fst (fun x -> x * 2) (3, "x") = (6, "x");;
(* Test map_snd *)
eq (1, "HELLO") (map_snd String.uppercase_ascii (1, "hello"));;
eq (5, 'B') (map_snd Char.uppercase_ascii (5, 'b'));;
t @@ fun () -> map_snd (fun x -> x * 2) ("x", 3) = ("x", 6);;
(* Test map *)
eq (2, "HELLO") (map (( + ) 1) String.uppercase_ascii (1, "hello"));;
t @@ fun () -> map (fun x -> x + 1) (fun y -> y * 2) (5, 10) = (6, 20);;
(* Test map_same *)
eq (2, 4) (map_same (fun x -> x * 2) (1, 2));;
eq (6, 8) (map_same (( + ) 1) (5, 7));;
(* Test map2 *)
eq (7, 11)
(map2 ( + ) ( * ) (2, 3) (5, 4))
;;
t @@ fun () -> map2 ( + ) ( - ) (1, 10) (2, 5) = (3, 5);;
(* Test map_same2 *)
eq (3, 12) (map_same2 ( + ) (1, 2) (2, 10));;
eq (5, 7) (map_same2 ( * ) (1, 1) (5, 7));;
(* Test fst_map and snd_map *)
eq 2 (fst_map (( + ) 1) (1, "hello"));;
eq "HELLO" (snd_map String.uppercase_ascii (1, "hello"));;
t @@ fun () -> fst_map (fun x -> x * 2) (5, true) = 10;;
t @@ fun () -> snd_map (fun x -> x * 2) (true, 5) = 10;;
(* Test iter *)
t @@ fun () ->
let r = ref 0 in
iter (fun a b -> r := a + b) (3, 7);
!r = 10
;;
(* Test swap *)
eq (2, 1) (swap (1, 2));;
eq ("world", "hello") (swap ("hello", "world"));;
t @@ fun () -> swap (swap (1, 2)) = (1, 2);;
(* Test operators *)
eq (2, "hello") ((( + ) 1) <<< (1, "hello"));;
eq (1, "HELLO") (String.uppercase_ascii >>> (1, "hello"));;
eq (2, "HELLO") ((( + ) 1 *** String.uppercase_ascii) (1, "hello"));;
(* Test &&& operator *)
t @@ fun () -> ((( + ) 1) &&& (( * ) 2)) 5 = (6, 10);;
t @@ fun () -> (String.length &&& String.uppercase_ascii) "hello" = (5, "HELLO");;
(* Test merge/fold *)
eq 3 (merge ( + ) (1, 2));;
eq 10 (fold ( * ) (2, 5));;
eq "HelloWorld" (merge ( ^ ) ("Hello", "World"));;
(* Test dup *)
eq (5, 5) (dup 5);;
eq ("x", "x") (dup "x");;
t @@ fun () -> let (a, b) = dup 42 in a = b;;
(* Test dup_map *)
eq (5, 10) (dup_map (( * ) 2) 5);;
eq ("hello", "HELLO") (dup_map String.uppercase_ascii "hello");;
t @@ fun () -> dup_map (fun x -> x + 1) 5 = (5, 6);;
(* Test equal *)
t @@ fun () -> equal Int.equal String.equal (1, "a") (1, "a");;
t @@ fun () -> not (equal Int.equal String.equal (1, "a") (1, "b"));;
t @@ fun () -> not (equal Int.equal String.equal (1, "a") (2, "a"));;
(* Test compare *)
t @@ fun () -> compare Int.compare String.compare (1, "a") (1, "a") = 0;;
t @@ fun () -> compare Int.compare String.compare (1, "a") (1, "b") < 0;;
t @@ fun () -> compare Int.compare String.compare (1, "b") (1, "a") > 0;;
t @@ fun () -> compare Int.compare String.compare (1, "x") (2, "x") < 0;;
t @@ fun () -> compare Int.compare String.compare (2, "x") (1, "x") > 0;;
(* Test to_string *)
eq "1,hello" (to_string Int.to_string CCFun.id (1, "hello"));;
eq "5::10" (to_string ~sep:"::" Int.to_string Int.to_string (5, 10));;
eq "true-false" (to_string ~sep:"-" Bool.to_string Bool.to_string (true, false));;
(* Property tests with QCheck *)
q Q.(pair int int) (fun p -> swap (swap p) = p);;
q Q.(pair int string) (fun p ->
map_fst CCFun.id p = map_fst (fun x -> x) p
);;
q Q.(pair int string) (fun p ->
map_snd CCFun.id p = map_snd (fun x -> x) p
);;
q Q.(pair int int) (fun (a, b) ->
merge ( + ) (a, b) = a + b
);;
q Q.int (fun x ->
dup x = (x, x)
);;
q Q.(pair int int) (fun p ->
equal Int.equal Int.equal p p
);;
q Q.(pair int int) (fun p ->
compare Int.compare Int.compare p p = 0
);;
q Q.(triple int int int) (fun (a, b, c) ->
let p1 = (a, b) in
let p2 = (a, c) in
if b = c then
equal Int.equal Int.equal p1 p2
else
not (equal Int.equal Int.equal p1 p2)
);;
q Q.(pair small_int small_int) (fun (a, b) ->
let p1 = (a, b) in
let p2 = (b, a) in
if a = b then
equal Int.equal Int.equal p1 p2
else
not (equal Int.equal Int.equal p1 p2)
);;

267
tests/core/t_ref.ml Normal file
View file

@ -0,0 +1,267 @@
open CCRef
module T = (val Containers_testlib.make ~__FILE__ ())
include T;;
t @@ fun () ->
let r = create 5 in
!r = 5
;;
t @@ fun () ->
let r = create "hello" in
!r = "hello"
;;
(* Test map *)
t @@ fun () ->
let r = ref 5 in
let r2 = map (( + ) 1) r in
!r2 = 6 && !r = 5
;;
t @@ fun () ->
let r = ref "hello" in
let r2 = map String.uppercase_ascii r in
!r2 = "HELLO" && !r = "hello"
;;
(* Test iter *)
t @@ fun () ->
let r = ref 5 in
let acc = ref 0 in
iter (fun x -> acc := !acc + x) r;
!acc = 5
;;
(* Test update *)
t @@ fun () ->
let r = ref 5 in
update (( + ) 3) r;
!r = 8
;;
t @@ fun () ->
let r = ref "hello" in
update String.uppercase_ascii r;
!r = "HELLO"
;;
t @@ fun () ->
let r = ref 10 in
update (fun x -> x * 2) r;
update (fun x -> x - 1) r;
!r = 19
;;
(* Test incr_then_get *)
t @@ fun () ->
let r = ref 5 in
let v = incr_then_get r in
v = 6 && !r = 6
;;
t @@ fun () ->
let r = ref 0 in
let v1 = incr_then_get r in
let v2 = incr_then_get r in
v1 = 1 && v2 = 2 && !r = 2
;;
(* Test get_then_incr *)
t @@ fun () ->
let r = ref 5 in
let v = get_then_incr r in
v = 5 && !r = 6
;;
t @@ fun () ->
let r = ref 0 in
let v1 = get_then_incr r in
let v2 = get_then_incr r in
v1 = 0 && v2 = 1 && !r = 2
;;
(* Test difference between incr_then_get and get_then_incr *)
t @@ fun () ->
let r1 = ref 5 in
let r2 = ref 5 in
let v1 = incr_then_get r1 in
let v2 = get_then_incr r2 in
v1 = 6 && v2 = 5 && !r1 = !r2
;;
(* Test swap *)
t @@ fun () ->
let r1 = ref 5 in
let r2 = ref 10 in
swap r1 r2;
!r1 = 10 && !r2 = 5
;;
t @@ fun () ->
let r1 = ref "hello" in
let r2 = ref "world" in
swap r1 r2;
!r1 = "world" && !r2 = "hello"
;;
t @@ fun () ->
let r1 = ref 1 in
let r2 = ref 2 in
swap r1 r2;
swap r1 r2;
!r1 = 1 && !r2 = 2
;;
(* Test protect *)
t @@ fun () ->
let r = ref 5 in
let result = protect r 10 (fun () -> !r) in
result = 10 && !r = 5
;;
t @@ fun () ->
let r = ref "original" in
let result = protect r "temp" (fun () ->
assert (!r = "temp");
"result"
) in
result = "result" && !r = "original"
;;
t @@ fun () ->
let r = ref 0 in
try
ignore (protect r 5 (fun () ->
assert (!r = 5);
failwith "error"
));
false
with Failure _ ->
!r = 0
;;
t @@ fun () ->
let r1 = ref 1 in
let r2 = ref 2 in
let result = protect r1 10 (fun () ->
protect r2 20 (fun () ->
!r1 + !r2
)
) in
result = 30 && !r1 = 1 && !r2 = 2
;;
(* Test compare *)
t @@ fun () ->
let r1 = ref 5 in
let r2 = ref 5 in
compare Int.compare r1 r2 = 0
;;
t @@ fun () ->
let r1 = ref 3 in
let r2 = ref 5 in
compare Int.compare r1 r2 < 0
;;
t @@ fun () ->
let r1 = ref 7 in
let r2 = ref 5 in
compare Int.compare r1 r2 > 0
;;
(* Test equal *)
t @@ fun () ->
let r1 = ref 5 in
let r2 = ref 5 in
equal Int.equal r1 r2
;;
t @@ fun () ->
let r1 = ref 5 in
let r2 = ref 6 in
not (equal Int.equal r1 r2)
;;
t @@ fun () ->
let r1 = ref "hello" in
let r2 = ref "hello" in
equal String.equal r1 r2
;;
(* Test to_list *)
eq [5] (to_list (ref 5));;
eq ["hello"] (to_list (ref "hello"));;
t @@ fun () ->
let r = ref 42 in
let l = to_list r in
List.length l = 1 && List.hd l = 42
;;
(* Test to_iter *)
t @@ fun () ->
let r = ref 5 in
let acc = ref 0 in
to_iter r (fun x -> acc := !acc + x);
!acc = 5
;;
t @@ fun () ->
let r = ref 10 in
let count = ref 0 in
to_iter r (fun _ -> incr count);
!count = 1
;;
(* Property-based tests *)
q Q.int (fun x ->
let r = create x in
!r = x
);;
q Q.int (fun x ->
let r = ref x in
let r2 = map CCFun.id r in
!r2 = !r
);;
q Q.int (fun x ->
let r = ref x in
update CCFun.id r;
!r = x
);;
q Q.int (fun x ->
let r = ref x in
incr_then_get r = x + 1 && !r = x + 1
);;
q Q.int (fun x ->
let r = ref x in
get_then_incr r = x && !r = x + 1
);;
q Q.(pair int int) (fun (x, y) ->
let r1 = ref x in
let r2 = ref y in
swap r1 r2;
!r1 = y && !r2 = x
);;
q Q.int (fun x ->
let r = ref 0 in
let result = protect r x (fun () -> !r) in
result = x && !r = 0
);;
q Q.int (fun x ->
let r = ref x in
equal Int.equal r r
);;
q Q.int (fun x ->
let r = ref x in
compare Int.compare r r = 0
);;

View file

@ -34,4 +34,358 @@ eq 42 (fold_ok ( + ) 2 (Ok 40));;
eq 40 (fold_ok ( + ) 40 (Error "foo"));;
eq (Ok []) (flatten_l []);;
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 *)
(* Test return and fail *)
eq (Ok 42) (return 42);;
eq (Error "failed") (fail "failed");;
(* Test of_exn and of_exn_trace *)
t @@ fun () ->
match of_exn (Failure "test") with
| Error msg -> String.length msg > 0
| Ok _ -> false
;;
t @@ fun () ->
match of_exn_trace (Failure "test") with
| Error msg -> String.length msg > 0
| Ok _ -> false
;;
(* Test opt_map *)
eq (Ok (Some 6)) (opt_map (fun x -> Ok (x * 2)) (Some 3));;
eq (Ok None) (opt_map (fun x -> Ok (x * 2)) None);;
eq (Error "err") (opt_map (fun _ -> Error "err") (Some 3));;
(* Test map *)
eq (Ok 3) (map (( + ) 1) (Ok 2));;
eq (Error "e") (map (( + ) 1) (Error "e"));;
t @@ fun () -> map String.uppercase_ascii (Ok "hello") = Ok "HELLO";;
(* Test map_err *)
eq (Ok 5) (map_err String.uppercase_ascii (Ok 5));;
eq (Error "ERROR") (map_err String.uppercase_ascii (Error "error"));;
(* Test map2 *)
eq (Ok "HELLO")
(map2 String.uppercase_ascii String.uppercase_ascii (Ok "hello"))
;;
eq (Error "ERROR")
(map2 String.uppercase_ascii String.uppercase_ascii (Error "error"))
;;
(* Test iter *)
t @@ fun () ->
let r = ref 0 in
iter (fun x -> r := x) (Ok 42);
!r = 42
;;
t @@ fun () ->
let r = ref 0 in
iter (fun x -> r := x) (Error "e");
!r = 0
;;
(* Test get_exn *)
eq 42 (get_exn (Ok 42));;
t @@ fun () ->
try
ignore (get_exn (Error "error"));
false
with Invalid_argument _ -> true
;;
(* Test get_or *)
eq 5 (get_or (Ok 5) ~default:0);;
eq 0 (get_or (Error "e") ~default:0);;
(* Test apply_or *)
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
;;
(* Test map_or *)
eq 10 (map_or (fun x -> x * 2) (Ok 5) ~default:0);;
eq 0 (map_or (fun x -> x * 2) (Error "e") ~default:0);;
(* Test catch *)
eq 5 (catch (Ok 5) ~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))
;;
(* Test flat_map *)
eq (Ok 3) (flat_map (fun x -> Ok (x + 1)) (Ok 2));;
eq (Error "e") (flat_map (fun x -> Ok (x + 1)) (Error "e"));;
eq (Error "e2") (flat_map (fun _ -> Error "e2") (Ok 2));;
(* Test fold *)
eq 10 (fold ~ok:CCFun.id ~error:(fun _ -> 0) (Ok 10));;
eq 0 (fold ~ok:CCFun.id ~error:(fun _ -> 0) (Error "e"));;
(* Test is_ok and is_error *)
t @@ fun () -> is_ok (Ok 1);;
t @@ fun () -> not (is_ok (Error "e"));;
t @@ fun () -> is_error (Error "e");;
t @@ fun () -> not (is_error (Ok 1));;
(* Test guard and guard_str *)
t @@ fun () ->
match guard (fun () -> 42) with
| Ok 42 -> true
| _ -> false
;;
t @@ fun () ->
match guard (fun () -> failwith "error") with
| Error _ -> true
| _ -> false
;;
t @@ fun () ->
match guard_str (fun () -> 42) with
| Ok 42 -> true
| _ -> false
;;
t @@ fun () ->
match guard_str (fun () -> failwith "test error") with
| Error msg -> String.length msg > 0
| _ -> false
;;
(* Test guard_str_trace *)
t @@ fun () ->
match guard_str_trace (fun () -> 42) with
| Ok 42 -> true
| _ -> false
;;
t @@ fun () ->
match guard_str_trace (fun () -> failwith "test error") with
| Error msg -> String.length msg > 0
| _ -> false
;;
(* Test wrap functions *)
eq (Ok 6) (wrap1 (( + ) 1) 5);;
t @@ fun () ->
match wrap1 (fun _ -> failwith "error") () with
| Error _ -> true
| _ -> false
;;
eq (Ok 7) (wrap2 ( + ) 3 4);;
t @@ fun () ->
match wrap2 (fun _ _ -> failwith "error") 1 2 with
| Error _ -> true
| _ -> false
;;
eq (Ok 10) (wrap3 (fun a b c -> a + b + c) 2 3 5);;
t @@ fun () ->
match wrap3 (fun _ _ _ -> failwith "error") 1 2 3 with
| Error _ -> true
| _ -> false
;;
(* Test pure *)
eq (Ok 42) (pure 42);;
(* Test join *)
eq (Ok 5) (join (Ok (Ok 5)));;
eq (Error "e") (join (Ok (Error "e")));;
eq (Error "e") (join (Error "e"));;
(* Test both *)
eq (Ok (3, 5)) (both (Ok 3) (Ok 5));;
eq (Error "e1") (both (Error "e1") (Ok 5));;
eq (Error "e2") (both (Ok 3) (Error "e2"));;
eq (Error "e1") (both (Error "e1") (Error "e2"));;
(* Test map_l *)
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 (Ok []) (map_l (fun x -> Ok x) []);;
(* Test fold_l *)
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 ])
;;
(* Test choose *)
eq (Ok 1) (choose [ Ok 1; 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 (Error [ "e1"; "e2"; "e3" ]) (choose [ Error "e1"; Error "e2"; Error "e3" ])
;;
eq (Error []) (choose []);;
(* Test retry *)
t @@ fun () ->
let attempts = ref 0 in
let f () =
incr attempts;
if !attempts < 3 then
Error "fail"
else
Ok "success"
in
match retry 5 f with
| Ok "success" -> !attempts = 3
| _ -> false
;;
t @@ fun () ->
let attempts = ref 0 in
let f () =
incr attempts;
Error "always fails"
in
match retry 3 f with
| Error errs -> !attempts = 3 && List.length errs = 3
| _ -> false
;;
(* Test to_opt *)
eq (Some 5) (to_opt (Ok 5));;
eq None (to_opt (Error "e"));;
(* Test of_opt *)
eq (Ok 5) (of_opt (Some 5));;
eq (Error "option is None") (of_opt None);;
(* Test equal *)
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 () -> 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 (Ok 5) (Error "e"));;
(* 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 6) < 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") (Ok 5) < 0;;
t @@ fun () -> compare ~err:String.compare Int.compare (Ok 5) (Error "a") > 0;;
(* Property-based tests *)
q Q.int (fun 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 -> 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
match r with
| Ok x -> v = x
| Error _ -> v = default)
;;
q
Q.(list (result int string))
(fun l ->
match flatten_l l with
| Ok values ->
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 *)
t @@ fun () -> map (( + ) 1) (Ok 2) = Ok 3;;
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 () -> both (Ok 3) (Ok 5) = Ok (3, 5);;
q Q.int (fun x -> return x = Ok x);;
q Q.int (fun x -> to_opt (Ok x) = Some x)