open Printf open Bi_io let rec deep_cycle = `Tuple [| `Shared deep_cycle |] let test_tree : tree = `Tuple [| `Unit; `Num_variant (0, None); `Num_variant (0, Some (`Svint 127)); `Array (Some (svint_tag, [| `Svint 1; `Svint 2 |])); `Tuple [| `Shared deep_cycle; `Shared deep_cycle |]; `Record [| (Some "abc", hash_name "abc", `String "hello"); (Some "number", hash_name "number", `Svint 123); (Some "variant1", hash_name "variant1", `Variant (Some "Foo", hash_name "Foo", Some (`Svint (-456)))); (Some "variant2", hash_name "variant2", `Variant (Some "Bar", hash_name "Bar", None)); |]; `Table ( Some ( [| (Some "name", hash_name "name", string_tag); (Some "age", hash_name "age", uvint_tag) |], [| [| `String "Francisco"; `Uvint 67 |]; [| `String "Mateo"; `Uvint 23 |]; [| `String "Clara"; `Uvint 27 |]; [| `String "Jose"; `Uvint 39 |]; |] ) ); `Array ( Some ( array_tag, [| `Array ( Some ( float64_tag, [| `Float64 1.234567; `Float64 2.345678; `Float64 3.456789; |] ) ); `Array ( Some ( float64_tag, [| `Float64 4.567890; `Float64 5.678901; `Float64 6.789012 |] ) ); `Array ( Some ( float64_tag, [| `Float64 7.890123; `Float64 8.901234; `Float64 9.012345 |] ) ); `Array ( Some ( float64_tag, [| `Float64 10.123456; `Float64 11.234567; `Float64 12.345678 |] ) ); |] ) ) |] let unhash = make_unhash [ "abc"; "number"; "variant1"; "variant2"; "Foo"; "Bar"; "name"; "age" ] let test () = let s = string_of_tree test_tree in let test_tree2 = tree_of_string ~unhash s in (s, String.length s, test_tree2, test_tree2 = test_tree) let test_json () = let s = "[\ null,\ null,\ 127,\ [1,2],\ [[1,[1]],1]\ {\"abc\":\"hello\",\ \"number\":123,\ \"variant1\":[\"Foo\",-456],\ \"variant2\":\"Bar\"},\ [[1,\"first\"],[2,\"second\"],[3,\"third\"],[4,\"fourth\"]],\ [\ {\"name\":\"Francisco\",\"age\":67},\ {\"name\":\"Mateo\",\"age\":23},\ {\"name\":\"Clara\",\"age\":27},\ {\"name\":\"Jose\",\"age\":39}\ ],\ [\ [1.234567,2.345678,3.456789],\ [4.567890,5.678901,6.789012],\ [7.890123,8.901234,9.012345],\ [10.123456,11.234567,12.345678]\ ],\ ]" in s, String.length s type foo = { abc : string; number : int; variant1 : [ `Foo of int ]; variant2 : [ `Bar ] } type person = { name : string; age : int } let native_test_tree = ( (), None, Some 127, [| 1; 2 |], { abc = "hello"; number = 123; variant1 = `Foo (-456); variant2 = `Bar }, [| 1, "first"; 2, "second"; 3, "third"; 4, "fourth"; |], [| { name = "Francisco"; age = 67 }; { name = "Mateo"; age = 23 }; { name = "Clara"; age = 27 }; { name = "Jose"; age = 39 }; |], [| [| 1.234567; 2.345678; 3.456789 |]; [| 4.567890; 5.678901; 6.789012 |]; [| 7.890123; 8.901234; 9.012345 |]; [| 10.123456; 11.234567; 12.345678 |] |] ) let marshal x = Marshal.to_string x [(*Marshal.No_sharing*)] let unmarshal s = Marshal.from_string s 0 let native_test_tree_marshalled = marshal native_test_tree let marshal_wr_perf n = for i = 1 to n do ignore (marshal native_test_tree) done let marshal_rd_perf n = for i = 1 to n do ignore (unmarshal native_test_tree_marshalled) done let test_tree_binioued = string_of_tree test_tree let biniou_wr_perf n = for i = 1 to n do ignore (string_of_tree test_tree) done let biniou_rd_perf n = for i = 1 to n do ignore (tree_of_string test_tree_binioued) done let time name f x = let t1 = Unix.gettimeofday () in ignore (f x); let t2 = Unix.gettimeofday () in Printf.printf "%s: %.3f\n%!" name (t2 -. t1) let wr_perf () = let n = 1_000_000 in time "wr biniou" biniou_wr_perf n; time "wr marshal" marshal_wr_perf n let rd_perf () = let n = 1_000_000 in time "rd biniou" biniou_rd_perf n; time "rd marshal" marshal_rd_perf n let eq x y = Marshal.to_string x [] = Marshal.to_string y [] let test_channels x = let file = "test_channels.bin" in let oc = open_out_bin file in let ob = Bi_outbuf.create_channel_writer oc in write_tree ob x; Bi_outbuf.flush_channel_writer ob; close_out oc; let ic = open_in_bin file in let ib = Bi_inbuf.from_channel ic in let x' = read_tree ib in if not (eq x x') then ( printf "Error in writing or reading via channels:\n"; Bi_io.print_view (string_of_tree x'); print_newline (); ) let () = Bi_io.safety_test (); let s = string_of_tree test_tree in Bi_io.print_view s; print_newline (); let x = tree_of_string s in if s <> string_of_tree x then printf "Error in writing or reading\n%!"; test_channels x; let oc = open_out_bin "test.bin" in output_string oc s; close_out oc; wr_perf (); rd_perf (); assert (Bi_stream.test [5; 3; 8; 4]); assert (Bi_stream.test [])