1 |
|
2 |
|
3 |
|
4 |
|
5 |
|
6 |
|
7 | type point_definition = {
|
8 | offset : int;
|
9 | identifier : int;
|
10 | }
|
11 |
|
12 |
|
13 |
|
14 | let try_finally x f h =
|
15 | let res =
|
16 | try
|
17 | f x
|
18 | with e ->
|
19 | (try h x with _ -> ());
|
20 | raise e in
|
21 | (try h x with _ -> ());
|
22 | res
|
23 |
|
24 | let try_in_channel bin x f =
|
25 | let open_ch = if bin then open_in_bin else open_in in
|
26 | try_finally (open_ch x) f (close_in_noerr)
|
27 |
|
28 | let try_out_channel bin x f =
|
29 | let open_ch = if bin then open_out_bin else open_out in
|
30 | try_finally (open_ch x) f (close_out_noerr)
|
31 |
|
32 |
|
33 |
|
34 |
|
35 |
|
36 | exception Invalid_file of string * string
|
37 |
|
38 | let magic_number_rtd = "BISECTOUT3"
|
39 |
|
40 | module Writer :
|
41 | sig
|
42 | type 'a t
|
43 |
|
44 | val int : int t
|
45 | val string : string t
|
46 | val pair : 'a t -> 'b t -> ('a * 'b) t
|
47 | val array : 'a t -> 'a array t
|
48 |
|
49 | val write : 'a t -> 'a -> string
|
50 | end =
|
51 | struct
|
52 | type 'a t = Buffer.t -> 'a -> unit
|
53 |
|
54 | let w =
|
55 | Printf.bprintf
|
56 |
|
57 | let int b i =
|
58 | w b " %i" i
|
59 |
|
60 | let string b s =
|
61 | w b " %i %s" (String.length s) s
|
62 |
|
63 | let pair left right b (l, r) =
|
64 | left b l;
|
65 | right b r
|
66 |
|
67 | let array element b a =
|
68 | w b " %i" (Array.length a);
|
69 | Array.iter (element b) a
|
70 |
|
71 | let write writer v =
|
72 | let b = Buffer.create 4096 in
|
73 | Buffer.add_string b magic_number_rtd;
|
74 | writer b v;
|
75 | Buffer.contents b
|
76 | end
|
77 |
|
78 | module Reader :
|
79 | sig
|
80 | type 'a t
|
81 |
|
82 | val int : int t
|
83 | val string : string t
|
84 | val pair : 'a t -> 'b t -> ('a * 'b) t
|
85 | val array : 'a t -> 'a array t
|
86 |
|
87 | val read : 'a t -> filename:string -> 'a
|
88 | end =
|
89 | struct
|
90 | type 'a t = Buffer.t -> in_channel -> 'a
|
91 |
|
92 | let junk c =
|
93 | try ignore (input_char c)
|
94 | with End_of_file -> ()
|
95 |
|
96 | let int b c =
|
97 | Buffer.clear b;
|
98 | let rec loop () =
|
99 | match input_char c with
|
100 | | exception End_of_file -> ()
|
101 | | ' ' -> ()
|
102 | | c -> Buffer.add_char b c; loop ()
|
103 | in
|
104 | loop ();
|
105 | int_of_string (Buffer.contents b)
|
106 |
|
107 | let string b c =
|
108 | let length = int b c in
|
109 | let s = really_input_string c length in
|
110 | junk c;
|
111 | s
|
112 |
|
113 | let pair left right b c =
|
114 | let l = left b c in
|
115 | let r = right b c in
|
116 | l, r
|
117 |
|
118 | let array element b c =
|
119 | let length = int b c in
|
120 | Array.init length (fun _index -> element b c)
|
121 |
|
122 | let read reader ~filename =
|
123 | try_in_channel true filename begin fun c ->
|
124 | let magic_number_in_file =
|
125 | try really_input_string c (String.length magic_number_rtd)
|
126 | with End_of_file ->
|
127 | raise
|
128 | (Invalid_file
|
129 | (filename, "unexpected end of file while reading magic number"))
|
130 | in
|
131 | if magic_number_in_file <> magic_number_rtd then
|
132 | raise (Invalid_file (filename, "bad magic number"));
|
133 |
|
134 | junk c;
|
135 |
|
136 | let b = Buffer.create 4096 in
|
137 | try reader b c
|
138 | with e ->
|
139 | raise
|
140 | (Invalid_file
|
141 | (filename, "exception reading data: " ^ Printexc.to_string e))
|
142 | end
|
143 | end
|
144 |
|
145 | let table : (string, int array * string) Hashtbl.t Lazy.t =
|
146 | lazy (Hashtbl.create 17)
|
147 |
|
148 | let reset_counters () =
|
149 | Lazy.force table
|
150 | |> Hashtbl.iter begin fun _ (point_state, _) ->
|
151 | match Array.length point_state with
|
152 | | 0 -> ()
|
153 | | n -> Array.fill point_state 0 (n - 1) 0
|
154 | end
|
155 |
|
156 | let runtime_data_to_string () =
|
157 | let data = Hashtbl.fold (fun k v acc -> (k, v)::acc) (Lazy.force table) [] in
|
158 | match data with
|
159 | | [] ->
|
160 | None
|
161 | | _ ->
|
162 | Array.of_list data
|
163 | |> Writer.(write (array (pair string (pair (array int) string))))
|
164 | |> fun s -> Some s
|
165 |
|
166 | let write_runtime_data channel =
|
167 | let data =
|
168 | match runtime_data_to_string () with
|
169 | | Some s -> s
|
170 | | None -> Writer.(write (array int)) [||]
|
171 | in
|
172 | output_string channel data
|
173 |
|
174 | let prng =
|
175 | Random.State.make_self_init () [@coverage off]
|
176 |
|
177 | let random_filename base_name =
|
178 | Printf.sprintf "%s%09d.coverage"
|
179 | base_name (abs (Random.State.int prng 1000000000))
|
180 |
|
181 | let write_points points =
|
182 | let points_array = Array.of_list points in
|
183 | Array.sort compare points_array;
|
184 | Marshal.to_string points_array []
|
185 |
|
186 | let get_relative_path file =
|
187 | if Filename.is_relative file then
|
188 | file
|
189 | else
|
190 | let cwd = Sys.getcwd () in
|
191 | let cwd_end = String.length cwd in
|
192 | let sep_length = String.length Filename.dir_sep in
|
193 | let sep_end = sep_length + cwd_end in
|
194 | try
|
195 | if String.sub file 0 cwd_end = cwd &&
|
196 | String.sub file cwd_end sep_length = Filename.dir_sep then
|
197 | String.sub file sep_end (String.length file - sep_end)
|
198 | else
|
199 | file
|
200 | with Invalid_argument _ ->
|
201 | file
|
202 |
|
203 | let read_runtime_data filename =
|
204 | Reader.(read (array (pair string (pair (array int) string)))) ~filename
|
205 | |> Array.to_list
|
206 | |> List.map (fun (file, data) -> get_relative_path file, data)
|
207 |
|
208 | let read_points s =
|
209 | let points_array : point_definition array = Marshal.from_string s 0 in
|
210 | Array.sort compare points_array;
|
211 | Array.to_list points_array
|
212 |
|
213 | let register_file file ~point_count ~point_definitions =
|
214 | let point_state = Array.make point_count 0 in
|
215 | let table = Lazy.force table in
|
216 | if not (Hashtbl.mem table file) then
|
217 | Hashtbl.add table file (point_state, point_definitions);
|
218 | `Staged (fun point_index ->
|
219 | let current_count = point_state.(point_index) in
|
220 | point_state.(point_index) <-
|
221 | if current_count < max_int then
|
222 | current_count + 1
|
223 | else
|
224 | current_count)
|
225 |
|
226 |
|
227 |
|
228 | let bisect_file = ref None
|
229 | let bisect_silent = ref None
|