t141_signed_int_limits.ml

   1 let () = Random.self_init ();;
   2
   3
   4 if not (
   5   fst (List.fold_left (fun (ok, i) (b,m) ->
   6                          let above_maxp = 1 lsl i in
   7                          let maxp = pred above_maxp in
   8                          let minp = - (above_maxp lsr 1) in
   9                          let below_minp = pred minp in
  10                          let gut =
  11                            try ignore (b maxp); true
  12                            with _ -> false in
  13                          let gut2 =
  14                            try ignore (b above_maxp); false
  15                            with _ -> true in
  16                          let gut3 =
  17                            try ignore (b minp); true
  18                            with _ -> false in
  19                          let gut4 =
  20                            try ignore (b below_minp); false
  21                            with _ -> true in
  22
  23
  24                          let gut5 =
  25                            let plage = Int32.shift_left 1l i in
  26                            let test () =
  27                              let signed_number =
  28                                Int32.to_int ( Int32.add (Random.int32 plage) (Int32.of_int minp) ) in
  29                              let bits = b signed_number in
  30                              let number' = m bits in
  31                                if signed_number = number' then true
  32                                else
  33                                  begin
  34                                    Printf.printf "bits:%d n=%d read=%d (%d %d)\n" i signed_number number' minp maxp;
  35                                    false
  36                                  end in
  37                            let res = ref true in
  38                              for i = 1 to 10_000 do
  39                                res := !res && test ()
  40                              done;
  41                              !res in
  42
  43                            (gut && gut2 && gut3 && gut4 && gut5 && ok, succ i)
  44
  45                       )
  46          (true, 9)
  47                          [
  48                            (fun n -> BITSTRING { n : 9 : signed }),
  49                            (fun b -> bitmatch b with { n: 9 : signed } -> n);
  50                            (fun n -> BITSTRING { n : 10 : signed }),
  51                            (fun b -> bitmatch b with  { n : 10 : signed } -> n);
  52                            (fun n -> BITSTRING { n : 11 : signed }),
  53                            (fun b -> bitmatch b with  { n : 11 : signed } -> n);
  54                            (fun n -> BITSTRING { n : 12 : signed }),
  55                            (fun b -> bitmatch b with  { n : 12 : signed } -> n);
  56                            (fun n -> BITSTRING { n : 13 : signed }),
  57                            (fun b -> bitmatch b with  { n : 13 : signed } -> n);
  58                            (fun n -> BITSTRING { n : 14 : signed }),
  59                            (fun b -> bitmatch b with  { n : 14 : signed } -> n);
  60                            (fun n -> BITSTRING { n : 15 : signed }),
  61                            (fun b -> bitmatch b with  { n : 15 : signed } -> n);
  62                            (fun n -> BITSTRING { n : 16 : signed }),
  63                            (fun b -> bitmatch b with  { n : 16 : signed } -> n);
  64                            (fun n -> BITSTRING { n : 17 : signed }),
  65                            (fun b -> bitmatch b with  { n : 17 : signed } -> n);
  66                            (fun n -> BITSTRING { n : 18 : signed }),
  67                            (fun b -> bitmatch b with  { n : 18 : signed } -> n);
  68                            (fun n -> BITSTRING { n : 19 : signed }),
  69                            (fun b -> bitmatch b with  { n : 19 : signed } -> n);
  70                            (fun n -> BITSTRING { n : 20 : signed }),
  71                            (fun b -> bitmatch b with  { n : 20 : signed } -> n);
  72                            (fun n -> BITSTRING { n : 21 : signed }),
  73                            (fun b -> bitmatch b with  { n : 21 : signed } -> n);
  74                            (fun n -> BITSTRING { n : 22 : signed }),
  75                            (fun b -> bitmatch b with  { n : 22 : signed } -> n);
  76                            (fun n -> BITSTRING { n : 23 : signed }),
  77                            (fun b -> bitmatch b with  { n : 23 : signed } -> n);
  78                            (fun n -> BITSTRING { n : 24 : signed }),
  79                            (fun b -> bitmatch b with  { n : 24 : signed } -> n);
  80                            (fun n -> BITSTRING { n : 25 : signed }),
  81                            (fun b -> bitmatch b with  { n : 25 : signed } -> n);
  82                            (fun n -> BITSTRING { n : 26 : signed }),
  83                            (fun b -> bitmatch b with  { n : 26 : signed } -> n);
  84                            (fun n -> BITSTRING { n : 27 : signed }),
  85                            (fun b -> bitmatch b with  { n : 27 : signed } -> n);
  86                            (fun n -> BITSTRING { n : 28 : signed }),
  87                            (fun b -> bitmatch b with  { n : 28 : signed } -> n);
  88                            (fun n -> BITSTRING { n : 29 : signed }),
  89                            (fun b -> bitmatch b with  { n : 29 : signed } -> n);
  90                            (fun n -> BITSTRING { n : 30 : signed }),
  91                            (fun b -> bitmatch b with  { n : 30 : signed } -> n);
  92                          ]
  93       ) &&
  94
  95     begin
  96       try
  97         if Sys.word_size = 32 then
  98           begin
  99             ignore (BITSTRING { max_int : 31 : signed });
 100             ignore (BITSTRING { min_int : 31 : signed });
 101           end
 102         else
 103           begin
 104             ignore (BITSTRING { pred (1 lsl 31) : 31 : signed });
 105             ignore (BITSTRING { (-1 lsl 30) : 31 : signed });
 106           end;
 107         true
 108       with
 109           _ ->
 110             false;
 111     end
 112
 113   &&
 114
 115     begin
 116       if Sys.word_size = 64 then
 117         try
 118           ignore (BITSTRING { 1 lsl 31 : 31 : signed });
 119           ignore (BITSTRING { pred (-1 lsl 30) : 31 : signed });
 120           false
 121         with _ -> true
 122       else
 123         true
 124     end
 125
 126 )
 127 then
 128   failwith("t141_signed_int_limits: failed")
 129
 130
 131 (* Manquent les tests random pour bits = 31 *)