swh:1:snp:61dcfc0dd5674a0e65803e88039c122d9532074e
Tip revision: 6e3eb2355976c287ceb3235590fd29716bf5aaf0 authored by Peter Duchovni on 16 July 2021, 18:30:44 UTC
Counterexample: extend inline_phantom
Counterexample: extend inline_phantom
Tip revision: 6e3eb23
test_json_stream.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
type json =
[ `O of (string * json) list
| `Bool of bool
| `Float of float
| `A of json list
| `Null
| `String of string ]
let pp_json : json Crowbar.printer =
fun fmt json -> Format.fprintf fmt "%s" (Data_encoding.Json.to_string json)
let ascii_letter =
let open Crowbar in
map [choose [range ~min:65 26; range ~min:97 26]] Char.chr
let names =
let open Crowbar in
map [list1 ascii_letter] (fun ls -> String.of_seq @@ List.to_seq ls)
let string =
let open Crowbar in
map [uint8; ascii_letter] String.make
let longstring =
let open Crowbar in
with_printer (fun fmt s ->
if String.length s < 8 then Format.fprintf fmt "\"%s\"" s
else Format.fprintf fmt "%c(%04d)" s.[0] (String.length s))
@@ map [range 4096; ascii_letter] String.make
let ezjson : json Crowbar.gen =
(* We don't generate random floats/strings because it doesn't roundtrip on
even the standard printer. *)
(* We generate long strings to test chunking. *)
let open Crowbar in
fix (fun json ->
let field = map [names; json] (fun k v -> (k, v)) in
choose
[
map [list field] (fun kvs ->
let (has_dup, _) =
List.fold_left
(fun (has, seen) (k, _) ->
let has = has || List.exists (( = ) k) seen in
if has then (has, []) else (has, k :: seen))
(false, [])
kvs
in
if has_dup then bad_test () else `O kvs);
map [bool] (fun b -> `Bool b);
map [list json] (fun vs -> `A vs);
const `Null;
map [string] (fun s -> `String s);
map [longstring] (fun s -> `String s);
map [int32] (fun i -> `Float (Int32.to_float i));
(* map [float] (fun f -> `Float f); *)
])
let ezjson = Crowbar.with_printer pp_json ezjson
let large_ezjson =
(* special generator for testing large values *)
let open Crowbar in
with_printer pp_json
@@ map [ezjson; ezjson; ezjson] (fun j1 j2 j3 ->
`A
(List.init 16 (fun _ ->
`A
(List.init 16 (fun _ ->
`O
[
("j1", j1);
("j2", `A [j2; `Bool true]);
("this", `Null);
("j3", j3);
])))))
let jsonm_lexeme_seq =
Crowbar.map [ezjson] Json_encoding.jsonm_lexeme_seq_of_ezjson
let () =
let open Crowbar in
add_test ~name:"gen" [jsonm_lexeme_seq] (fun j ->
ignore j ;
check true)
let () =
let open Crowbar in
add_test ~name:"small_string_serialisation" [jsonm_lexeme_seq] (fun j ->
let s =
Data_encoding.Json.small_string_seq_of_jsonm_lexeme_seq ~newline:false j
in
Seq.iter ignore s)
let () =
let open Crowbar in
add_test
~name:"small_string_serialisation-deserialisation"
[ezjson]
(fun ezj ->
let j = Json_encoding.jsonm_lexeme_seq_of_ezjson ezj in
let s =
Data_encoding.Json.small_string_seq_of_jsonm_lexeme_seq ~newline:false j
in
let s = Seq.fold_left ( ^ ) "" s in
match Data_encoding.Json.from_string s with
| Error e -> fail e
| Ok j -> check_eq ~pp:pp_json ezj j)
let () =
let open Crowbar in
add_test ~name:"serialisation" [jsonm_lexeme_seq] (fun j ->
let s =
Data_encoding.Json.string_seq_of_jsonm_lexeme_seq
~newline:false
~chunk_size_hint:512
j
in
Seq.iter ignore s)
let () =
let open Crowbar in
add_test ~name:"serialisation(16)-deserialisation" [ezjson] (fun ezj ->
let j = Json_encoding.jsonm_lexeme_seq_of_ezjson ezj in
let s =
Data_encoding.Json.string_seq_of_jsonm_lexeme_seq
~newline:false
~chunk_size_hint:16
j
in
let s = Seq.fold_left ( ^ ) "" s in
match Data_encoding.Json.from_string s with
| Error e -> fail e
| Ok j -> check_eq ~pp:pp_json ezj j)
let () =
let open Crowbar in
add_test ~name:"serialisation(1024)-deserialisation" [ezjson] (fun ezj ->
let j = Json_encoding.jsonm_lexeme_seq_of_ezjson ezj in
let s =
Data_encoding.Json.string_seq_of_jsonm_lexeme_seq
~newline:false
~chunk_size_hint:1024
j
in
let s = Seq.fold_left ( ^ ) "" s in
match Data_encoding.Json.from_string s with
| Error e -> fail e
| Ok j -> check_eq ~pp:pp_json ezj j)
let () =
let open Crowbar in
add_test ~name:"blit-instructions(32)" [ezjson] (fun ezj ->
let j = Json_encoding.jsonm_lexeme_seq_of_ezjson ezj in
let buffer = Bytes.create 32 in
let s =
Data_encoding.Json.blit_instructions_seq_of_jsonm_lexeme_seq
~newline:false
~buffer
j
in
let s =
let b = Buffer.create 8 in
Seq.iter (fun (s, o, l) -> Buffer.add_subbytes b s o l) s ;
Buffer.contents b
in
match Data_encoding.Json.from_string s with
| Error e -> fail e
| Ok j -> check_eq ~pp:pp_json ezj j)
let () =
let open Crowbar in
add_test ~name:"blit-instructions(1024)" [ezjson] (fun ezj ->
let j = Json_encoding.jsonm_lexeme_seq_of_ezjson ezj in
let buffer = Bytes.create 1024 in
let s =
Data_encoding.Json.blit_instructions_seq_of_jsonm_lexeme_seq
~newline:false
~buffer
j
in
let s =
let b = Buffer.create 8 in
Seq.iter (fun (s, o, l) -> Buffer.add_subbytes b s o l) s ;
Buffer.contents b
in
match Data_encoding.Json.from_string s with
| Error e -> fail e
| Ok j -> check_eq ~pp:pp_json ezj j)
let () =
let open Crowbar in
add_test ~name:"large value, blit instructions" [large_ezjson] (fun ezj ->
let j = Json_encoding.jsonm_lexeme_seq_of_ezjson ezj in
let buffer = Bytes.create 128 in
let s =
Data_encoding.Json.blit_instructions_seq_of_jsonm_lexeme_seq
~newline:false
~buffer
j
in
let s =
let b = Buffer.create 128 in
Seq.iter (fun (s, o, l) -> Buffer.add_subbytes b s o l) s ;
Buffer.contents b
in
match Data_encoding.Json.from_string s with
| Error e -> fail e
| Ok j -> check_eq ~pp:pp_json ezj j)