test_ancient_shared.ml

   1 (* Very basic tests of Ancient module shared functionality.
   2  * $Id: test_ancient_shared.ml,v 1.2 2006-09-27 18:39:44 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 md = Ancient.attach fd in
  74
  75       eprintf "After attaching %s ...\n" share_filename;
  76       gc_compact ();
  77
  78       let data : item array Ancient.ancient = Ancient.get md 0 in
  79       eprintf "After getting ...\n";
  80       gc_compact ();
  81
  82       let chan = open_out print_filename in
  83       output_data chan (Ancient.follow data);
  84       close_out chan;
  85
  86       Ancient.detach md;
  87       eprintf "After detaching ...\n";
  88       gc_compact ()
  89
  90   | ["write"; share_filename; print_filename] ->
  91       (* Generate random data and write to filename, also print it. *)
  92       eprintf "Before allocating data on OCaml heap ...\n";
  93       gc_compact ();
  94       let data =
  95         Array.init 100000 (
  96           fun id ->
  97             { id = id;
  98               name = random_string ();
  99               dob = random_string ();
 100               address = random_string ();
 101               phone = random_string_option ();
 102               marital_status = random_marital_status () }
 103         ) in
 104       eprintf "After allocating data on OCaml heap ...\n";
 105       gc_compact ();
 106
 107       let chan = open_out print_filename in
 108       output_data chan data;
 109       close_out chan;
 110
 111       let fd =
 112         Unix.openfile share_filename
 113           [Unix.O_CREAT;Unix.O_TRUNC;Unix.O_RDWR] 0o644 in
 114       let md = Ancient.attach fd in
 115
 116       ignore (Ancient.share md 0 data);
 117       eprintf "After sharing data to %s ...\n" share_filename;
 118       gc_compact ();
 119
 120       Ancient.detach md;
 121       eprintf "After detaching ...\n";
 122       gc_compact ()
 123
 124   | _ ->
 125       failwith "test_ancient_shared"
 126
 127