1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
open! Import
open! Blit
(* This unit test checks that when [blit] calls [unsafe_blit], the slices are valid.
It also checks that [blit] doesn't call [unsafe_blit] when there is a range error. *)
let%test_module _ =
(module struct
let blit_was_called = ref false
let slices_are_valid = ref (Ok ())
module B = Make (struct
type t = bool array
let create ~len = Array.create false ~len
let length = Array.length
let unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len =
blit_was_called := true;
slices_are_valid
:= Or_error.try_with (fun () ->
assert (len >= 0);
assert (src_pos >= 0);
assert (src_pos + len <= Array.length src);
assert (dst_pos >= 0);
assert (dst_pos + len <= Array.length dst));
Array.blit ~src ~src_pos ~dst ~dst_pos ~len
;;
end)
let%test_module "Bool" =
(module Test_blit.Test
(struct
type t = bool
let equal = Bool.equal
let of_bool = Fn.id
end)
(struct
type t = bool array [@@deriving sexp_of]
let create ~len = Array.create false ~len
let length = Array.length
let get = Array.get
let set = Array.set
end)
(B))
;;
let%test_unit _ =
let opts = [ None; Some (-1); Some 0; Some 1; Some 2 ] in
List.iter [ 0; 1; 2 ] ~f:(fun src ->
List.iter [ 0; 1; 2 ] ~f:(fun dst ->
List.iter opts ~f:(fun src_pos ->
List.iter opts ~f:(fun src_len ->
List.iter opts ~f:(fun dst_pos ->
try
let check f =
blit_was_called := false;
slices_are_valid := Ok ();
match Or_error.try_with f with
| Error _ -> assert (not !blit_was_called)
| Ok () -> ok_exn !slices_are_valid
in
check (fun () ->
B.blito
~src:(Array.create ~len:src false)
?src_pos
?src_len
~dst:(Array.create ~len:dst false)
?dst_pos
());
check (fun () ->
ignore
(B.subo (Array.create ~len:src false) ?pos:src_pos ?len:src_len
: bool array))
with
| exn ->
raise_s
[%message
"failure"
(exn : exn)
(src : int)
(src_pos : int option)
(src_len : int option)
(dst : int)
(dst_pos : int option)])))))
;;
end)
;;
|
