test_ancient_shared.ml

   1 (* Very basic tests of Ancient module shared functionality.
   2  * $Id: test_ancient_shared.ml,v 1.3 2006-09-28 12:40:07 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 (* XXX Linux/AMD64-specific hack to avoid bad mmap(2) allocation. *)
  69 let baseaddr = Nativeint.of_string "0x440000000000"
  70
  71 let () =
  72   match List.tl (Array.to_list Sys.argv) with
  73   | ["read"; share_filename; print_filename] ->
  74       (* Read data in filename and print. *)
  75       let fd = Unix.openfile share_filename [Unix.O_RDWR] 0 in
  76       let md = Ancient.attach fd 0n in
  77
  78       eprintf "After attaching %s ...\n" share_filename;
  79       gc_compact ();
  80
  81       let data : item array Ancient.ancient = Ancient.get md 0 in
  82       eprintf "After getting ...\n";
  83       gc_compact ();
  84
  85       let chan = open_out print_filename in
  86       output_data chan (Ancient.follow data);
  87       close_out chan;
  88
  89       Ancient.detach md;
  90       eprintf "After detaching ...\n";
  91       gc_compact ()
  92
  93   | ["write"; share_filename; print_filename] ->
  94       (* Generate random data and write to filename, also print it. *)
  95       eprintf "Before allocating data on OCaml heap ...\n";
  96       gc_compact ();
  97       let data =
  98         Array.init 100000 (
  99           fun id ->
 100             { id = id;
 101               name = random_string ();
 102               dob = random_string ();
 103               address = random_string ();
 104               phone = random_string_option ();
 105               marital_status = random_marital_status () }
 106         ) in
 107       eprintf "After allocating data on OCaml heap ...\n";
 108       gc_compact ();
 109
 110       let chan = open_out print_filename in
 111       output_data chan data;
 112       close_out chan;
 113
 114       let fd =
 115         Unix.openfile share_filename
 116           [Unix.O_CREAT;Unix.O_TRUNC;Unix.O_RDWR] 0o644 in
 117       let md = Ancient.attach fd baseaddr in
 118
 119       ignore (Ancient.share md 0 data);
 120       eprintf "After sharing data to %s ...\n" share_filename;
 121       gc_compact ();
 122
 123       Ancient.detach md;
 124       eprintf "After detaching ...\n";
 125       gc_compact ()
 126
 127   | _ ->
 128       failwith "test_ancient_shared"
 129
 130