test_ancient_shared.ml

   1 (* Very basic tests of Ancient module shared functionality.
   2  * $Id: test_ancient_shared.ml,v 1.1 2006-09-27 16:01:47 rich Exp $
   3  *)
   4
   5 open Printf
   6
   7 type item = {
   8   name : string;
   9   dob : string;
  10   address : string;
  11   phone : string option;
  12   marital_status : marital_status;
  13   id : int;
  14 }
  15 and marital_status = Single | Married | Divorced
  16
  17 let gc_compact () =
  18   eprintf "compacting ... %!";
  19   Gc.compact ();
  20   let stat = Gc.stat () in
  21   let live_words = stat.Gc.live_words in
  22   eprintf "live words = %d (%d MB)\n%!"
  23     live_words (live_words * 8 / 1024 / 1024)
  24
  25 let random_string () =
  26   let n = 1 + Random.int 20 in
  27   let str = String.create n in
  28   for i = 0 to n-1 do
  29     let c = 97 + Random.int 26 in
  30     let c = Char.chr c in
  31     str.[i] <- c
  32   done;
  33   str
  34
  35 let random_string_option () =
  36   if Random.int 3 = 1 then None else Some (random_string ())
  37
  38 let random_marital_status () =
  39   match Random.int 3 with
  40   | 0 -> Single
  41   | 1 -> Married
  42   | _ -> Divorced
  43
  44 let rec output_data chan data =
  45   let n = Array.length data in
  46   for i = 0 to n-1; do
  47     output_item chan data.(i)
  48   done
  49
  50 and output_item chan item =
  51   fprintf chan "id = %d\n%!" item.id;
  52   fprintf chan "\tname = %s\n%!" item.name;
  53   fprintf chan "\tdob = %s\n%!" item.dob;
  54   fprintf chan "\taddress = %s\n%!" item.address;
  55   fprintf chan "\tphone = %s\n%!"
  56     (match item.phone with
  57      | None -> "None"
  58      | Some str -> "Some " ^ str);
  59   fprintf chan "\tmarital_status = %s\n%!"
  60     (string_of_marital_status item.marital_status)
  61
  62 and string_of_marital_status status =
  63   match status with
  64   | Single -> "Single"
  65   | Married -> "Married"
  66   | Divorced -> "Divorced"
  67
  68 let () =
  69   match List.tl (Array.to_list Sys.argv) with
  70   | ["read"; share_filename; print_filename] ->
  71       (* Read data in filename and print. *)
  72       let fd = Unix.openfile share_filename [Unix.O_RDWR] 0 in
  73       let data : item array Ancient.ancient = Ancient.attach fd in
  74
  75       eprintf "After attaching %s ...\n" share_filename;
  76       gc_compact ();
  77
  78       let chan = open_out print_filename in
  79       output_data chan (Ancient.follow data);
  80       close_out chan;
  81
  82       Ancient.detach data;
  83       eprintf "After detaching ...\n";
  84       gc_compact ()
  85
  86   | ["write"; share_filename; print_filename] ->
  87       (* Generate random data and write to filename, also print it. *)
  88       eprintf "Before allocating data on OCaml heap ...\n";
  89       gc_compact ();
  90       let data =
  91         Array.init 100000 (
  92           fun id ->
  93             { id = id;
  94               name = random_string ();
  95               dob = random_string ();
  96               address = random_string ();
  97               phone = random_string_option ();
  98               marital_status = random_marital_status () }
  99         ) in
 100       eprintf "After allocating data on OCaml heap ...\n";
 101       gc_compact ();
 102
 103       let chan = open_out print_filename in
 104       output_data chan data;
 105       close_out chan;
 106
 107       let fd =
 108         Unix.openfile share_filename
 109           [Unix.O_CREAT;Unix.O_TRUNC;Unix.O_RDWR] 0o644 in
 110
 111       let data = Ancient.share fd data in
 112       eprintf "After sharing data to %s ...\n" share_filename;
 113       gc_compact ();
 114
 115       Ancient.detach data;
 116       eprintf "After detaching ...\n";
 117       gc_compact ()
 118
 119   | _ ->
 120       failwith "test_ancient_shared"
 121
 122