tests/20_varsize.ml

   1 (* Construct and match against random variable sized strings.
   2  * $Id$
   3  *)
   4
   5 open Printf
   6
   7 let nr_passes = 10000
   8 let max_size = 8                        (* max field size in bits *)
   9
  10 (* let () = Bitmatch.debug := true *)
  11
  12 (* Return a full 64 bits of randomness. *)
  13 let rand64 () =
  14   let r0 = Int64.shift_left (Int64.of_int (Random.bits ())) 34 in (* 30 bits *)
  15   let r1 = Int64.shift_left (Int64.of_int (Random.bits ())) 4 in (* 30 bits *)
  16   let r2 = Int64.of_int (Random.int 16) in (* 4 bits *)
  17   Int64.logor (Int64.logor r0 r1) r2
  18
  19 (* Return unsigned mask of length bits, bits <= 64. *)
  20 let mask64 bits =
  21   if bits < 63 then Int64.pred (Int64.shift_left 1L bits)
  22   else if bits = 63 then Int64.max_int
  23   else if bits = 64 then -1L
  24   else invalid_arg "mask64"
  25
  26 (* Return a random number between 0 and 2^bits-1 where bits <= 64. *)
  27 let rand bits =
  28   let r = rand64 () in
  29   let m = mask64 bits in
  30   Int64.logand r m
  31
  32 (* Dump the state in case there is an error. *)
  33 let dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz bits r0 r1 r2 r3 =
  34   eprintf "dumping state:\n";
  35   eprintf "  0: %3d - %016Lx - %016Lx\n" n0sz n0 r0;
  36   eprintf "  1: %3d - %016Lx - %016Lx\n" n1sz n1 r1;
  37   eprintf "  2: %3d - %016Lx - %016Lx\n" n2sz n2 r2;
  38   eprintf "  3: %3d - %016Lx - %016Lx\n" n3sz n3 r3;
  39   eprintf "bits (length = %d):\n" (Bitmatch.bitstring_length bits);
  40   Bitmatch.hexdump_bitstring stderr bits;
  41   eprintf "%!"
  42
  43 let () =
  44   Random.self_init ();
  45
  46   for pass = 0 to nr_passes-1 do
  47     let n0sz = 1 + Random.int (max_size-1) in
  48     let n0   = rand n0sz in
  49     let n1sz = 1 + Random.int (max_size-1) in
  50     let n1   = rand n1sz in
  51     let n2sz = 1 + Random.int (max_size-1) in
  52     let n2   = rand n2sz in
  53     let n3sz = 1 + Random.int (max_size-1) in
  54     let n3   = rand n3sz in
  55
  56     (* Construct the bitstring. *)
  57     let bits =
  58       try
  59         (BITSTRING {
  60            n0 : n0sz;
  61            n1 : n1sz;
  62            n2 : n2sz;
  63            n3 : n3sz
  64          })
  65       with
  66         Bitmatch.Construct_failure (msg, _, _, _) ->
  67           eprintf "FAILED: Construct_failure %s\n%!" msg;
  68           dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz
  69             (Bitmatch.empty_bitstring) 0L 0L 0L 0L;
  70           exit 2 in
  71
  72     let r0, r1, r2, r3 =
  73       bitmatch bits with
  74       | { r0 : n0sz; r1 : n1sz; r2 : n2sz; r3 : n3sz; rest : -1 : bitstring } ->
  75           let rest_len = Bitmatch.bitstring_length rest in
  76           if rest_len <> 0 then (
  77             eprintf "FAILED: rest is not zero length (length = %d)\n%!"
  78               rest_len;
  79             dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz bits 0L 0L 0L 0L;
  80             exit 2
  81           );
  82           r0, r1, r2, r3
  83       | { _ } ->
  84           eprintf "FAILED: bitmatch operator did not match\n%!";
  85           dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz bits 0L 0L 0L 0L;
  86           exit 2 in
  87
  88     (*dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz bits r0 r1 r2 r3;*)
  89
  90     if n0 <> r0 || n1 <> r1 || n2 <> r2 || n3 <> r3 then (
  91       eprintf "FAILED: numbers returned from match are different\n%!";
  92       dump n0 n0sz n1 n1sz n2 n2sz n3 n3sz bits r0 r1 r2 r3;
  93       exit 2
  94     )
  95   done