path: root/test/Moretest/intext.ml

(* Test for output_value / input_value *)

type t = A | B of int | C of float | D of string | E of char
       | F of t | G of t * t | H of int * t | I of t * float | J

let longstring =
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
let verylongstring =
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\
 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

let bigint = Int64.to_int 0x123456789ABCDEF0L

let rec fib n =
  if n < 2 then 1 else fib(n-1) + fib(n-2)

let test_out filename =
  let oc = open_out_bin filename in
  output_value oc 1;
  output_value oc (-1);
  output_value oc 258;
  output_value oc 20000;
  output_value oc 0x12345678;
  output_value oc bigint;
  output_value oc "foobargeebuz";
  output_value oc longstring;
  output_value oc verylongstring;
  output_value oc 3.141592654;
  output_value oc ();
  output_value oc A;
  output_value oc (B 1);
  output_value oc (C 2.718);
  output_value oc (D "hello, world!");
  output_value oc (E 'l');
  output_value oc (F(B 1));
  output_value oc (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e')))));
  output_value oc (H(1, A));
  output_value oc (I(B 2, 1e-6));
  let x = D "sharing" in
  let y = G(x, x) in
  let z = G(y, G(x, y)) in
  output_value oc z;
  output_value oc [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|];
  let rec big n = if n <= 0 then A else H(n, big(n-1)) in
  output_value oc (big 1000);
  Marshal.to_channel oc y [Marshal.No_sharing];
  Marshal.to_channel oc fib [Marshal.Closures];
  output_value oc (Int32.of_string "0");
  output_value oc (Int32.of_string "123456");
  output_value oc (Int32.of_string "-123456");
  output_value oc (Int64.of_string "0");
  output_value oc (Int64.of_string "123456789123456");
  output_value oc (Int64.of_string "-123456789123456");
  output_value oc (Nativeint.of_string "0");
  output_value oc (Nativeint.of_string "123456");
  output_value oc (Nativeint.of_string "-123456");
  output_value oc (Nativeint.shift_left (Nativeint.of_string "123456789") 32);
  output_value oc (Nativeint.shift_left (Nativeint.of_string "-123456789") 32);
  let i = Int64.of_string "123456789123456" in output_value oc (i,i);
  close_out oc


let test n b =
  prerr_string "Test "; prerr_int n;
  if b then prerr_string " passed.\n" else prerr_string " FAILED.\n";
  flush stderr

let test_in filename =
  let ic = open_in_bin filename in
  test 1 (input_value ic = 1);
  test 2 (input_value ic = (-1));
  test 3 (input_value ic = 258);
  test 4 (input_value ic = 20000);
  test 5 (input_value ic = 0x12345678);
  test 6 (input_value ic = bigint);
  test 7 (input_value ic = "foobargeebuz");
  test 8 (input_value ic = longstring);
  test 9 (input_value ic = verylongstring);
  test 10 (input_value ic = 3.141592654);
  test 11 (input_value ic = ());
  test 12 (match input_value ic with
    A -> true
  | _ -> false);
  test 13 (match input_value ic with
    (B 1) -> true
  | _ -> false);
  test 14 (match input_value ic with
    (C f) -> f = 2.718
  | _ -> false);
  test 15 (match input_value ic with
    (D "hello, world!") -> true
  | _ -> false);
  test 16 (match input_value ic with
    (E 'l') -> true
  | _ -> false);
  test 17 (match input_value ic with
    (F(B 1)) -> true
  | _ -> false);
  test 18 (match input_value ic with
    (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
  | _ -> false);
  test 19 (match input_value ic with
    (H(1, A)) -> true
  | _ -> false);
  test 20 (match input_value ic with
    (I(B 2, 1e-6)) -> true
  | _ -> false);
  test 21 (match input_value ic with
    G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
      t1 == t2 && t3 == t5 && t4 == t1
  | _ -> false);
  test 22 (input_value ic = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
  let rec check_big n t =
    if n <= 0 then
      test 23 (match t with A -> true | _ -> false)
    else
      match t with H(m, s) -> if m = n then check_big (n-1) s
                                       else test 23 false
                 | _ -> test 23 false
  in
    check_big 1000 (input_value ic);
  test 24 (match input_value ic with
    G((D "sharing" as t1), (D "sharing" as t2)) -> t1 != t2
  | _ -> false);
  test 25 (let fib = input_value ic in fib 5 = 8 && fib 10 = 89);
  test 26 (input_value ic = Int32.of_string "0");
  test 27 (input_value ic = Int32.of_string "123456");
  test 28 (input_value ic = Int32.of_string "-123456");
  test 29 (input_value ic = Int64.of_string "0");
  test 30 (input_value ic = Int64.of_string "123456789123456");
  test 31 (input_value ic = Int64.of_string "-123456789123456");
  test 32 (input_value ic = Nativeint.of_string "0");
  test 33 (input_value ic = Nativeint.of_string "123456");
  test 34 (input_value ic = Nativeint.of_string "-123456");
  test 35 (input_value ic =
             Nativeint.shift_left (Nativeint.of_string "123456789") 32);
  test 36 (input_value ic =
             Nativeint.shift_left (Nativeint.of_string "-123456789") 32);
  let ((i, j) : int64 * int64) = input_value ic in
  test 37 (i = Int64.of_string "123456789123456");
  test 38 (j = Int64.of_string "123456789123456");
  test 39 (i == j);
  close_in ic

let test_string () =
  let s = Marshal.to_string 1 [] in
  test 101 (Marshal.from_string s 0 = 1);
  let s = Marshal.to_string (-1) [] in
  test 102 (Marshal.from_string s 0 = (-1));
  let s = Marshal.to_string 258 [] in
  test 103 (Marshal.from_string s 0 = 258);
  let s = Marshal.to_string 20000 [] in
  test 104 (Marshal.from_string s 0 = 20000);
  let s = Marshal.to_string 0x12345678 [] in
  test 105 (Marshal.from_string s 0 = 0x12345678);
  let s = Marshal.to_string bigint [] in
  test 106 (Marshal.from_string s 0 = bigint);
  let s = Marshal.to_string "foobargeebuz" [] in
  test 107 (Marshal.from_string s 0 = "foobargeebuz");
  let s = Marshal.to_string longstring [] in
  test 108 (Marshal.from_string s 0 = longstring);
  let s = Marshal.to_string verylongstring [] in
  test 109 (Marshal.from_string s 0 = verylongstring);
  let s = Marshal.to_string 3.141592654 [] in
  test 110 (Marshal.from_string s 0 = 3.141592654);
  let s = Marshal.to_string () [] in
  test 111 (Marshal.from_string s 0 = ());
  let s = Marshal.to_string A [] in
  test 112 (match Marshal.from_string s 0 with
    A -> true
  | _ -> false);
  let s = Marshal.to_string (B 1) [] in
  test 113 (match Marshal.from_string s 0 with
    (B 1) -> true
  | _ -> false);
  let s = Marshal.to_string (C 2.718) [] in
  test 114 (match Marshal.from_string s 0 with
    (C f) -> f = 2.718
  | _ -> false);
  let s = Marshal.to_string (D "hello, world!") [] in
  test 115 (match Marshal.from_string s 0 with
    (D "hello, world!") -> true
  | _ -> false);
  let s = Marshal.to_string (E 'l') [] in
  test 116 (match Marshal.from_string s 0 with
    (E 'l') -> true
  | _ -> false);
  let s = Marshal.to_string (F(B 1)) [] in
  test 117 (match Marshal.from_string s 0 with
    (F(B 1)) -> true
  | _ -> false);
  let s = Marshal.to_string (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [] in
  test 118 (match Marshal.from_string s 0 with
    (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
  | _ -> false);
  let s = Marshal.to_string (H(1, A)) [] in
  test 119 (match Marshal.from_string s 0 with
    (H(1, A)) -> true
  | _ -> false);
  let s = Marshal.to_string (I(B 2, 1e-6)) [] in
  test 120 (match Marshal.from_string s 0 with
    (I(B 2, 1e-6)) -> true
  | _ -> false);
  let x = D "sharing" in
  let y = G(x, x) in
  let z = G(y, G(x, y)) in
  let s = Marshal.to_string z [] in
  test 121 (match Marshal.from_string s 0 with
    G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
      t1 == t2 && t3 == t5 && t4 == t1
  | _ -> false);
  let s = Marshal.to_string [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [] in
  test 122 (Marshal.from_string s 0 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
  let rec big n = if n <= 0 then A else H(n, big(n-1)) in
  let s = Marshal.to_string (big 1000) [] in
  let rec check_big n t =
    if n <= 0 then
      test 123 (match t with A -> true | _ -> false)
    else
      match t with H(m, s) -> if m = n then check_big (n-1) s
                                       else test 123 false
                 | _ -> test 123 false
  in
    check_big 1000 (Marshal.from_string s 0)

let test_buffer () =
  let s = String.create 512 in
  Marshal.to_buffer s 0 512 1 [];
  test 201 (Marshal.from_string s 0 = 1);
  Marshal.to_buffer s 0 512 (-1) [];
  test 202 (Marshal.from_string s 0 = (-1));
  Marshal.to_buffer s 0 512 258 [];
  test 203 (Marshal.from_string s 0 = 258);
  Marshal.to_buffer s 0 512 20000 [];
  test 204 (Marshal.from_string s 0 = 20000);
  Marshal.to_buffer s 0 512 0x12345678 [];
  test 205 (Marshal.from_string s 0 = 0x12345678);
  Marshal.to_buffer s 0 512 bigint [];
  test 206 (Marshal.from_string s 0 = bigint);
  Marshal.to_buffer s 0 512 "foobargeebuz" [];
  test 207 (Marshal.from_string s 0 = "foobargeebuz");
  Marshal.to_buffer s 0 512 longstring [];
  test 208 (Marshal.from_string s 0 = longstring);
  test 209
    (try Marshal.to_buffer s 0 512 verylongstring []; false
     with Failure "Marshal.to_buffer: buffer overflow" -> true);
  Marshal.to_buffer s 0 512 3.141592654 [];
  test 210 (Marshal.from_string s 0 = 3.141592654);
  Marshal.to_buffer s 0 512 () [];
  test 211 (Marshal.from_string s 0 = ());
  Marshal.to_buffer s 0 512 A [];
  test 212 (match Marshal.from_string s 0 with
    A -> true
  | _ -> false);
  Marshal.to_buffer s 0 512 (B 1) [];
  test 213 (match Marshal.from_string s 0 with
    (B 1) -> true
  | _ -> false);
  Marshal.to_buffer s 0 512 (C 2.718) [];
  test 214 (match Marshal.from_string s 0 with
    (C f) -> f = 2.718
  | _ -> false);
  Marshal.to_buffer s 0 512 (D "hello, world!") [];
  test 215 (match Marshal.from_string s 0 with
    (D "hello, world!") -> true
  | _ -> false);
  Marshal.to_buffer s 0 512 (E 'l') [];
  test 216 (match Marshal.from_string s 0 with
    (E 'l') -> true
  | _ -> false);
  Marshal.to_buffer s 0 512 (F(B 1)) [];
  test 217 (match Marshal.from_string s 0 with
    (F(B 1)) -> true
  | _ -> false);
  Marshal.to_buffer s 0 512 (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [];
  test 218 (match Marshal.from_string s 0 with
    (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
  | _ -> false);
  Marshal.to_buffer s 0 512 (H(1, A)) [];
  test 219 (match Marshal.from_string s 0 with
    (H(1, A)) -> true
  | _ -> false);
  Marshal.to_buffer s 0 512 (I(B 2, 1e-6)) [];
  test 220 (match Marshal.from_string s 0 with
    (I(B 2, 1e-6)) -> true
  | _ -> false);
  let x = D "sharing" in
  let y = G(x, x) in
  let z = G(y, G(x, y)) in
  Marshal.to_buffer s 0 512 z [];
  test 221 (match Marshal.from_string s 0 with
    G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
      t1 == t2 && t3 == t5 && t4 == t1
  | _ -> false);
  Marshal.to_buffer s 0 512 [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [];
  test 222 (Marshal.from_string s 0 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
  let rec big n = if n <= 0 then A else H(n, big(n-1)) in
  test 223
    (try Marshal.to_buffer s 0 512 (big 1000) []; false
     with Failure "Marshal.to_buffer: buffer overflow" -> true)

let test_size() =
  let s = Marshal.to_string (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [] in
  test 300 (Marshal.header_size + Marshal.data_size s 0 = String.length s)

external marshal_to_block
   : string -> int -> 'a -> Marshal.extern_flags list -> unit
   = "marshal_to_block"
external marshal_from_block : string -> int -> 'a = "marshal_from_block"
external static_alloc : int -> string = "static_alloc"

let test_block () =
  let s = static_alloc 512 in
  marshal_to_block s 512 1 [];
  test 401 (marshal_from_block s 512 = 1);
  marshal_to_block s 512 (-1) [];
  test 402 (marshal_from_block s 512 = (-1));
  marshal_to_block s 512 258 [];
  test 403 (marshal_from_block s 512 = 258);
  marshal_to_block s 512 20000 [];
  test 404 (marshal_from_block s 512 = 20000);
  marshal_to_block s 512 0x12345678 [];
  test 405 (marshal_from_block s 512 = 0x12345678);
  marshal_to_block s 512 bigint [];
  test 406 (marshal_from_block s 512 = bigint);
  marshal_to_block s 512 "foobargeebuz" [];
  test 407 (marshal_from_block s 512 = "foobargeebuz");
  marshal_to_block s 512 longstring [];
  test 408 (marshal_from_block s 512 = longstring);
  test 409
    (try marshal_to_block s 512 verylongstring []; false
     with Failure "Marshal.to_buffer: buffer overflow" -> true);
  marshal_to_block s 512 3.141592654 [];
  test 410 (marshal_from_block s 512 = 3.141592654);
  marshal_to_block s 512 () [];
  test 411 (marshal_from_block s 512 = ());
  marshal_to_block s 512 A [];
  test 412 (match marshal_from_block s 512 with
    A -> true
  | _ -> false);
  marshal_to_block s 512 (B 1) [];
  test 413 (match marshal_from_block s 512 with
    (B 1) -> true
  | _ -> false);
  marshal_to_block s 512 (C 2.718) [];
  test 414 (match marshal_from_block s 512 with
    (C f) -> f = 2.718
  | _ -> false);
  marshal_to_block s 512 (D "hello, world!") [];
  test 415 (match marshal_from_block s 512 with
    (D "hello, world!") -> true
  | _ -> false);
  marshal_to_block s 512 (E 'l') [];
  test 416 (match marshal_from_block s 512 with
    (E 'l') -> true
  | _ -> false);
  marshal_to_block s 512 (F(B 1)) [];
  test 417 (match marshal_from_block s 512 with
    (F(B 1)) -> true
  | _ -> false);
  marshal_to_block s 512 (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) [];
  test 418 (match marshal_from_block s 512 with
    (G(A, G(B 2, G(C 3.14, G(D "glop", E 'e'))))) -> true
  | _ -> false);
  marshal_to_block s 512 (H(1, A)) [];
  test 419 (match marshal_from_block s 512 with
    (H(1, A)) -> true
  | _ -> false);
  marshal_to_block s 512 (I(B 2, 1e-6)) [];
  test 420 (match marshal_from_block s 512 with
    (I(B 2, 1e-6)) -> true
  | _ -> false);
  let x = D "sharing" in
  let y = G(x, x) in
  let z = G(y, G(x, y)) in
  marshal_to_block s 512 z [];
  test 421 (match marshal_from_block s 512 with
    G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) ->
      t1 == t2 && t3 == t5 && t4 == t1
  | _ -> false);
  marshal_to_block s 512 [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [];
  test 422 (marshal_from_block s 512 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]);
  let rec big n = if n <= 0 then A else H(n, big(n-1)) in
  test 423
    (try marshal_to_block s 512 (big 1000) []; false
     with Failure _ -> true);
  test 424
    (try marshal_to_block s 512 "Hello, world!" [];
         marshal_from_block s 8;
         false
     with Failure _ -> true)

(* Test for really big objects *)

let counter = ref 0

let rec make_big n =
  if n <= 0 then begin
    incr counter; B !counter
  end else begin
    let l = make_big (n-1) in
    let r = make_big (n-1) in
    G(l, r)
  end

let rec check_big n x =
  if n <= 0 then begin
    match x with
      B k -> incr counter; k = !counter
    | _   -> false
  end else begin
    match x with
      G(l, r) -> check_big (n-1) l && check_big (n-1) r
    | _       -> false
  end

let main() =
  if Array.length Sys.argv <= 2 then begin
    test_out "intext.data"; test_in "intext.data";
    test_out "intext.data"; test_in "intext.data";
    Sys.remove "intext.data";
    test_string();
    test_buffer();
    test_size();
    test_block()
  end else
  if Sys.argv.(1) = "make" then begin
    let n = int_of_string Sys.argv.(2) in
    let oc = open_out_bin "intext.data" in
    counter := 0;
    output_value oc (make_big n);
    close_out oc
  end else
  if Sys.argv.(1) = "test" then begin
    let n = int_of_string Sys.argv.(2) in
    let ic = open_in_bin "intext.data" in
    let b = (input_value ic : t) in
    Gc.full_major();
    close_in ic;
    counter := 0;
    if check_big n b then
      Printf.printf "Test big %d passed" n
    else
      Printf.printf "Test big %d FAILED" n;
    print_newline()
  end

let _ = Printexc.catch main (); exit 0