~ubuntu-branches/ubuntu/lucid/bin-prot/lucid

« back to all changes in this revision

Viewing changes to lib_test/mac_test.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stefano Zacchiroli
  • Date: 2008-05-09 15:24:37 UTC
  • Revision ID: james.westby@ubuntu.com-20080509152437-7gils45p37xcs40c
Tags: upstream-1.0.5
ImportĀ upstreamĀ versionĀ 1.0.5

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(*pp camlp4o -I ../lib -I `ocamlfind query type-conv` pa_type_conv.cmo pa_bin_prot.cmo *)
 
2
 
 
3
open Printf
 
4
open Bigarray
 
5
open Bin_prot
 
6
open Common
 
7
open Utils
 
8
 
 
9
TYPE_CONV_PATH "Mac_test"
 
10
 
 
11
(* Checks correct behavior for empty types *)
 
12
type empty with bin_io
 
13
 
 
14
module type S = sig
 
15
  (* Checks correct behavior for type signatures with variance annotations. *)
 
16
  type +'a t with bin_io
 
17
end
 
18
 
 
19
module PolyInhTest = struct
 
20
  type x = [ `X1 | `X2 ] with bin_io
 
21
  type y = [ `Y1 | `Y2 ] with bin_io
 
22
  type xy = [ x | `FOO | `Bar of int * float | y ] with bin_io
 
23
end
 
24
 
 
25
type tuple = float * string * int64
 
26
with bin_io
 
27
 
 
28
type 'a record = { a : int; b : 'a; c : 'b. 'b option }
 
29
with bin_io
 
30
 
 
31
type 'a singleton_record = { y : 'a }
 
32
with bin_io
 
33
 
 
34
type 'a sum = Foo | Bar of int | Bla of 'a * string
 
35
with bin_io
 
36
 
 
37
type 'a variant = [ `Foo | `Bar of int | `Bla of 'a * string ]
 
38
with bin_io
 
39
 
 
40
type 'a poly_app = (tuple * int singleton_record * 'a record) variant sum list
 
41
with bin_io
 
42
 
 
43
type 'a rec_t1 = RecFoo1 of 'a rec_t2
 
44
and 'a rec_t2 = RecFoo2 of 'a poly_app * 'a rec_t1 | RecNone
 
45
with bin_io
 
46
 
 
47
type 'a poly_id = 'a rec_t1
 
48
with bin_io
 
49
 
 
50
type el = float poly_id
 
51
with bin_io
 
52
 
 
53
type els = el array
 
54
with bin_io
 
55
 
 
56
let mb = 1024. *. 1024.
 
57
 
 
58
let main () =
 
59
  (* Allocate buffer (= bigstring) *)
 
60
  let buf = create_buf 10000 in
 
61
 
 
62
  (* Define array of dummy elements to be marshalled *)
 
63
  let el =
 
64
    let record = { a = 17; b = 2.78; c = None } in
 
65
    let arg = (3.1, "foo", 42L), { y = 4321 }, record in
 
66
    let variant = `Bla (arg, "fdsa") in
 
67
    let sum = Bla (variant, "asdf") in
 
68
    let poly_app = [ sum ] in
 
69
    RecFoo1 (RecFoo2 (poly_app, RecFoo1 RecNone))
 
70
  in
 
71
  let x = Array.create 10 el in
 
72
 
 
73
  let n = 100_000 in
 
74
 
 
75
  (* Write n times *)
 
76
  let t1 = Unix.gettimeofday () in
 
77
  for i = 1 to n do
 
78
    ignore (bin_write_els buf ~pos:0 x)
 
79
  done;
 
80
  let t2 = Unix.gettimeofday () in
 
81
  let write_time = t2 -. t1 in
 
82
 
 
83
  (* Read n times *)
 
84
  let t1 = Unix.gettimeofday () in
 
85
  for i = 1 to n do
 
86
    let pos_ref = ref 0 in
 
87
    ignore (bin_read_els buf ~pos_ref)
 
88
  done;
 
89
  let t2 = Unix.gettimeofday () in
 
90
  let read_time = t2 -. t1 in
 
91
 
 
92
  (* Write, read, and verify *)
 
93
  let end_pos = bin_write_els buf ~pos:0 x in
 
94
  let pos_ref = ref 0 in
 
95
  let y = bin_read_els buf ~pos_ref in
 
96
  assert (!pos_ref = end_pos && x = y);
 
97
 
 
98
  (* Print result *)
 
99
  let f_n = float n in
 
100
  let msg_size = float (n * end_pos) in
 
101
  printf
 
102
    "msgs: %d  msg length: %d\n\
 
103
    write time: %.3fs  write rate: %9.2f msgs/s  write throughput: %.2f MB/s\n\
 
104
    \ read time: %.3fs   read rate: %9.2f msgs/s   read throughput: %.2f MB/s\n%!"
 
105
    n end_pos
 
106
    write_time (f_n /. write_time) (msg_size /. write_time /. mb)
 
107
    read_time (f_n /. read_time) (msg_size /. read_time /. mb)
 
108
 
 
109
let () =
 
110
  try main ()
 
111
  with Read_error (err, pos) ->
 
112
    eprintf "Uncaught exception: %s: %d\n%!" (ReadError.to_string err) pos