@@ -57,10 +57,9 @@ struct
57
57
Array1. fill ba 0 ;
58
58
ba
59
59
60
- let cleanup _ = ()
60
+ let cleanup _ = ()
61
61
62
- let precond n _s = match n with
63
- | _ -> true
62
+ let precond _n _s = true
64
63
65
64
let run n ba = match n with
66
65
| Size_in_bytes -> Res (STM. int , Array1. size_in_bytes ba)
@@ -70,16 +69,18 @@ struct
70
69
(* | Sub (i,l) -> Res (result (array char) exn, protect (Array.sub a i) l) *)
71
70
| Fill n -> Res (result unit exn , protect (Array1. fill ba) n)
72
71
72
+ let word_size_in_bytes = Sys. word_size / 8
73
+
73
74
let postcond n (s :int list ) res = match n, res with
74
- | Size_in_bytes , Res ((Int,_ ),i ) -> i = 8 * (List. length s)
75
+ | Size_in_bytes , Res ((Int,_ ),r ) -> r = word_size_in_bytes * (List. length s)
75
76
| Get i , Res ((Result (Int,Exn),_ ), r ) ->
76
77
if i < 0 || i > = List. length s
77
- then r = Error (Invalid_argument " index out of bounds" )
78
- else r = Ok (List. nth s i)
78
+ then r = Error (Invalid_argument " index out of bounds" )
79
+ else r = Ok (List. nth s i)
79
80
| Set (i ,_ ), Res ((Result (Unit,Exn),_ ), r ) ->
80
81
if i < 0 || i > = List. length s
81
- then r = Error (Invalid_argument " index out of bounds" )
82
- else r = Ok ()
82
+ then r = Error (Invalid_argument " index out of bounds" )
83
+ else r = Ok ()
83
84
(* STM don't support bigarray type for the moment*)
84
85
(* | Sub (i,l), Res ((Result (Array Char,Exn),_), r) ->
85
86
if i < 0 || l < 0 || i+l > List.length s
92
93
module BigArraySTM_seq = STM_sequential. Make (BAConf )
93
94
module BigArraySTM_dom = STM_domain. Make (BAConf )
94
95
;;
95
- QCheck_base_runner. run_tests_main
96
- (let count = 1000 in
97
- [BigArraySTM_seq. agree_test ~count ~name: " STM BigArray test sequential" ;
98
- BigArraySTM_dom. neg_agree_test_par ~count ~name: " STM BigArray test parallel"
99
- ])
96
+ QCheck_base_runner. run_tests_main [
97
+ BigArraySTM_seq. agree_test ~count: 1000 ~name: " STM BigArray test sequential" ;
98
+ BigArraySTM_dom. neg_agree_test_par ~count: 5000 ~name: " STM BigArray test parallel"
99
+ ]
0 commit comments