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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
let opt_files = ref ([] : string list)
let opt_taken = ref "sail_coverage"
let opt_all = ref "all_branches"
let opt_tab_width = ref 4
let options =
Arg.align [
( "-t",
Arg.String (fun str -> opt_taken := str),
"<file> coverage information for branches taken while executing the model (default: sail_coverage)");
( "-a",
Arg.String (fun str -> opt_all := str),
"<file> information about all possible branches (default: all_branches)");
( "--tab-width",
Arg.Int (fun n -> opt_tab_width := n),
"<integer> set the tab width for html output (default: 4)")
]
type span = {
file : string;
l1 : int;
c1 : int;
l2 : int;
c2 : int;
}
module Span = struct
type t = span
let compare s1 s2 = compare s1 s2
end
module SpanSet = Set.Make(Span)
module SpanMap = Map.Make(Span)
let mk_span _ file l1 c1 l2 c2 = { file = Filename.basename file; l1 = l1; c1 = c1; l2 = l2; c2 = c2 }
let read_coverage filename =
let spans = ref SpanSet.empty in
let chan = open_in filename in
try
let rec loop () =
let line = input_line chan in
spans := SpanSet.add (Scanf.sscanf line "%c %S, %d, %d, %d, %d" mk_span) !spans;
loop ()
in
loop ()
with End_of_file ->
close_in chan;
!spans
(** We color the source either red (bad) or green (good) if it's
covered vs uncovered. If we have nested uncovered branches, they
will be increasingly bad, whereas nested covered branches will be
increasingly good. *)
type source_char = {
mutable badness : int;
mutable goodness : int;
char : char;
}
let mark_bad_region source span =
source.(span.l1 - 1).(span.c1).badness <- source.(span.l1 - 1).(span.c1).badness + 1;
source.(span.l2 - 1).(span.c2 - 1).badness <- source.(span.l2 - 1).(span.c2 - 1).badness - 1
let mark_good_region source span =
source.(span.l1 - 1).(span.c1).goodness <- source.(span.l1 - 1).(span.c1).goodness + 1;
source.(span.l2 - 1).(span.c2 - 1).goodness <- source.(span.l2 - 1).(span.c2 - 1).goodness - 1
let process_line l = Array.init (String.length l) (fun n -> { badness = 0; goodness = 0; char = l.[n] })
let read_source filename =
let lines = ref [] in
let chan = open_in filename in
try
let rec loop () =
lines := process_line (input_line chan) :: !lines;
loop ()
in
loop ()
with End_of_file ->
close_in chan;
Array.of_list (List.rev !lines)
let output_html_char chan c =
if c == ' ' then
output_string chan " "
else if c == '<' then
output_string chan "<"
else if c == '>' then
output_string chan ">"
else if c == '"' then
output_string chan """
else if c == '\t' then
output_string chan (String.concat "" (List.init !opt_tab_width (fun _ -> " ")))
else
output_char chan c
let main () =
let all = read_coverage !opt_all in
let taken = read_coverage !opt_taken in
List.iter (fun file ->
let all = SpanSet.filter (fun s -> s.file = Filename.basename file) all in
let taken = SpanSet.filter (fun s -> s.file = Filename.basename file) taken in
let not_taken = SpanSet.diff all taken in
let source = read_source file in
SpanSet.iter (mark_good_region source) taken;
SpanSet.iter (mark_bad_region source) not_taken;
let output_file = Filename.remove_extension (Filename.basename file) ^ ".html" in
let chan = open_out output_file in
let current_goodness = ref 0 in
let current_badness = ref 0 in
let good_color () =
let darken = 0xE0 - (!current_goodness * 0x20) in
Printf.sprintf "#%xFF%x" darken darken
in
let bad_color () =
let darken = 0xE0 - (!current_badness * 0x20) in
Printf.sprintf "#FF%x%x" darken darken
in
output_string chan "<!DOCTYPE html>\n";
output_string chan "<html lang=\"en\">\n<head>\n<meta charset=\"utf-8\">\n";
output_string chan (Printf.sprintf "<title>%s</title>" (Filename.remove_extension (Filename.basename file)));
output_string chan "</head>\n";
output_string chan "<body>\n";
output_string chan "<code style=\"display: block\">\n";
Array.iter (fun line ->
Array.iter (fun loc ->
if loc.goodness < 0 && loc.badness < 0 then (
output_html_char chan loc.char;
current_goodness := !current_goodness + loc.goodness;
current_badness := !current_badness + loc.badness;
for _ = 1 to abs loc.goodness + abs loc.badness do
output_string chan (Printf.sprintf "</span>")
done
) else if loc.goodness < 0 then (
assert (loc.badness >= 0);
output_html_char chan loc.char;
current_goodness := !current_goodness + loc.goodness;
for _ = 1 to abs loc.goodness do
output_string chan (Printf.sprintf "</span>")
done
) else if loc.badness < 0 then (
assert (loc.goodness >= 0);
output_html_char chan loc.char;
current_badness := !current_badness + loc.badness;
for _ = 1 to abs loc.badness do
output_string chan (Printf.sprintf "</span>")
done
) else if loc.badness > 0 then (
assert (loc.goodness <= 0);
current_badness := !current_badness + loc.badness;
for _ = 1 to loc.badness do
output_string chan (Printf.sprintf "<span style=\"background-color: %s\">" (bad_color ()));
done;
output_html_char chan loc.char
) else if loc.goodness > 0 then (
assert (!current_badness == 0);
current_goodness := !current_goodness + loc.goodness;
for _ = 1 to loc.goodness do
output_string chan (Printf.sprintf "<span style=\"background-color: %s\">" (good_color ()));
done;
output_html_char chan loc.char
) else (
output_html_char chan loc.char
);
assert (!current_goodness >= 0);
assert (!current_badness >= 0)
) line;
output_string chan "<br>\n"
) source;
output_string chan "</code>\n";
output_string chan "</body>\n";
output_string chan "</html>";
close_out chan;
Printf.printf "%s (%d/%d)\n" file (SpanSet.cardinal taken) (SpanSet.cardinal all)
) !opt_files
let usage_msg = "usage: sail-coverage-viz -c <file> -a <file> <.sail files>\n"
let _ =
Arg.parse options
(fun s -> opt_files := !opt_files @ [s])
usage_msg;
try main () with
| Sys_error msg -> prerr_endline msg; exit 1
|
