ocaml-containers/tests/core/t_utf8string.ml

open CCUtf8_string
module T = (val Containers_testlib.make ~__FILE__ ())
include T;;

eq ~cmp:(=) ~printer:Q.Print.(list (fun c -> string_of_int@@ Uchar.to_int c))
  (to_list (of_string_exn "aébõ😀")) (to_seq (of_string_exn "aébõ😀") |> CCList.of_seq);;

(* make sure it's persisted correctly *)
t @@ fun () ->
  let s = (of_string_exn "aébõ😀") in
  let seq = to_seq s in
  let l = to_list s in
  let testeq seq = assert_equal ~cmp:(=) l (CCList.of_seq seq) in
  testeq seq;
  testeq seq;
  testeq seq;
  true;;

let printer s = String.escaped (to_string s)
let pp_uchar (c:Uchar.t) = Printf.sprintf "0x%x" (Uchar.to_int c)

let arb_uchar =
  let rec gen  = lazy (
    let open Q.Gen in
    Q.Gen.int_range Uchar.(to_int min) Uchar.(to_int max) >>= fun n ->
    try return (Uchar.of_int n)
    with _ -> Lazy.force gen
  ) in
  Q.make
    ~print:(fun c -> Printf.sprintf "<uchar '%d'>" (Uchar.to_int c))
    (Lazy.force gen)

let uutf_is_valid s =
try
  Uutf.String.fold_utf_8
    (fun () _ -> function
       | `Malformed _ -> raise Exit
       | `Uchar _ -> ())
    () s;
  true
with Exit ->
  false

let uutf_to_iter s f =
Uutf.String.fold_utf_8
  (fun () _ -> function
     | `Malformed _ -> f (Uchar.of_int 0xfffd)
     | `Uchar c -> f c)
    () s

let uutf_of_l l =
  let buf = Buffer.create 32 in
  List.iter (Uutf.Buffer.add_utf_8 buf) l;
  Buffer.contents buf;;

t @@ fun () ->
  let s = of_string_exn "このため、" in
  let s' = to_iter s |> of_iter in
  assert_equal ~cmp:equal ~printer s s';
  true;;

q Q.small_string (fun s ->
    Q.assume (CCString.for_all (fun c -> Char.code c < 128) s);
    is_valid s);;

q ~long_factor:10
  Q.small_string (fun s ->
    Q.assume (CCString.for_all (fun c -> Char.code c < 128) s);
    s = (of_string_exn s |> to_iter|> of_iter|> to_string)
  );;

q ~long_factor:10
  Q.string (fun s ->
    Q.assume (CCString.for_all (fun c -> Char.code c < 128) s);
    String.length s = List.length (of_string_exn s |> to_list)
  );;

q ~long_factor:10 ~count:20_000
  Q.(small_list arb_uchar) (fun l ->
      let s = of_list l in
      l = to_list s);;

q ~long_factor:10
  Q.(small_list arb_uchar) (fun l ->
      let s = of_list l in
      l = (to_list @@ of_gen @@ to_gen s)
  );;

q ~long_factor:10
  Q.(small_list arb_uchar) (fun l ->
      let s = of_list l in
      l = (to_list @@ of_iter @@ to_iter s)
  );;

t @@ fun () -> not (is_valid "\192\181");;
t @@ fun () -> not (is_valid "\193\143");;
t @@ fun () -> not (is_valid "\224\151\167");;
t @@ fun () -> not (is_valid "\224\137\165");;
t @@ fun () -> is_valid "\240\151\189\163";;

q ~long_factor:40
  Q.string (fun s ->
    Q.assume (is_valid s);
    let s = of_string_exn s in
    let s2 = s |> to_iter|> of_iter in
    if s=s2 then true
    else Q.Test.fail_reportf "s=%S, s2=%S" (to_string s)(to_string s2)
  );;

q ~long_factor:40
  Q.string (fun s ->
    Q.assume (is_valid s);
    let s = of_string_exn s in
    let s2 = s |> to_gen |> of_gen in
    if s=s2 then true
    else Q.Test.fail_reportf "s=%S, s2=%S" (to_string s)(to_string s2)
  );;

(* compare with uutf *)

q ~long_factor:40 ~count:50_000
  Q.small_string (fun s ->
    let v1 = is_valid s in
    let v2 = uutf_is_valid s in
    if v1=v2 then true
    else Q.Test.fail_reportf "s:%S, valid: %B, uutf_valid: %B" s v1 v2
  );;

q ~long_factor:40 ~count:50_000
  Q.(small_list arb_uchar) (fun l ->
    let pp s = Q.Print.(list pp_uchar) s in
    let uutf = uutf_of_l l in
    let s = (of_list l:>string) in
    if uutf = s then true
    else Q.Test.fail_reportf "l: '%s', uutf: '%s', containers: '%s'"
      (pp l) uutf s
  );;

q ~long_factor:40 ~count:50_000
  Q.small_string (fun s ->
    Q.assume (is_valid s && uutf_is_valid s);
    let pp s = Q.Print.(list pp_uchar) s in
    let l_uutf = uutf_to_iter s |> Iter.to_list in
    let l_co = of_string_exn s |> to_iter |> Iter.to_list in
    if l_uutf = l_co then true
    else Q.Test.fail_reportf "uutf: '%s', containers: '%s', is_valid %B, uutf_is_valid %B"
      (pp l_uutf) (pp l_co) (is_valid s) (uutf_is_valid s)
  );;

t @@ fun () ->
  for i = 0 to 127 do
    let c = Uchar.of_int i in
    assert_equal 1 (n_bytes (of_list [c]))
  done;
  true ;;

q Q.(small_list arb_uchar) (fun l ->
  of_list l = concat empty (List.map of_uchar l));;

q Q.(pair small_nat arb_uchar) (fun (i,c) ->
  make i c = concat empty (CCList.init i (fun _ -> of_uchar c)));;