diff options
Diffstat (limited to 'sailcov/main.ml')
| -rw-r--r-- | sailcov/main.ml | 163 |
1 files changed, 144 insertions, 19 deletions
diff --git a/sailcov/main.ml b/sailcov/main.ml index d16fe9ba..2ca765e4 100644 --- a/sailcov/main.ml +++ b/sailcov/main.ml @@ -7,6 +7,8 @@ let opt_all = ref "all_branches" let opt_tab_width = ref 4 +let opt_index = ref None + type color = { hue: int; saturation: int; @@ -28,12 +30,21 @@ let options = ( "-t", Arg.String (fun str -> opt_taken := str), "<file> coverage information for branches taken while executing the model (default: sail_coverage)"); + ( "--taken", + Arg.String (fun str -> opt_taken := str), + " long form of -t"); ( "-a", Arg.String (fun str -> opt_all := str), "<file> information about all possible branches (default: all_branches)"); + ( "--all", + Arg.String (fun str -> opt_all := str), + " long form of -a"); ( "--tab-width", Arg.Int (fun n -> opt_tab_width := n), "<integer> set the tab width for html output (default: 4)"); + ( "--index", + Arg.String (fun str -> opt_index := Some str), + " create an index.html page"); ( "--covered-hue", Arg.Int (fun n -> opt_good_color := { !opt_good_color with hue = clamp_degree n }), "<int> set the hue (between 0 and 360) of the color used for code that is covered (default: 120 (green))"); @@ -65,6 +76,9 @@ type span = { c2 : int; } +let string_of_span span = + Printf.sprintf "\"%s\" %d:%d - %d:%d" span.file span.l1 span.c1 span.l2 span.c2 + module Span = struct type t = span let compare s1 s2 = compare s1 s2 @@ -96,18 +110,27 @@ let read_coverage filename = type source_char = { mutable badness : int; mutable goodness : int; + mutable bad_zero_width: bool; char : char; } +let zero_width span = span.l1 = span.l2 && span.c1 = span.c2 + 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 + if zero_width span then ( + source.(span.l2 - 1).(span.c2 - 1).bad_zero_width <- true + ) else ( + 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] }) + if not (zero_width span) then ( + 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]; bad_zero_width = false }) let read_source filename = let lines = ref [] in @@ -135,34 +158,103 @@ let output_html_char chan c = output_string chan (String.concat "" (List.init !opt_tab_width (fun _ -> " "))) else output_char chan c - + +let file_info file all taken = + 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 percent = + if SpanSet.cardinal all != 0 then + let p = 100. *. (Float.of_int (SpanSet.cardinal taken) /. Float.of_int (SpanSet.cardinal all)) in + Printf.sprintf "%.0f%%" p + else + "-" + in + + taken, + not_taken, + Printf.sprintf "%s (%d/%d) %s" (Filename.basename file) (SpanSet.cardinal taken) (SpanSet.cardinal all) percent + +let index_css = " +body, html { + width: 100%; + height: 100%; + margin: 0; + padding: 0; +} + +table { + width: 100%; + height: 100%; + margin: 0; + padding: 0; + border-collapse: collapse; + overflow: hidden; +} + +.left { + width: 20%; +} + +.left .scroll { + height: 100vh; + overflow-x: hidden; + overflow-y: auto; +} + +.right { + width: 80%; +} + +td { + padding: 0; + margin: 0; +} + +tr { + padding: 0; + margin: 0; + height: 100%; + overflow-x: hidden; + overflow-y: auto; +} + +iframe { + height: 100%; + width: 100%; + display: block; + margin: 0; + padding: 0; +} +" + 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 taken, not_taken, desc = file_info file all taken in + print_endline desc; + 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 clamp_lightness l = max 30 (min 80 l) in - + let html_color color darkness = Printf.sprintf "hsl(%d, %d%%, %d%%)" color.hue color.saturation (clamp_lightness ((80 + !opt_darken) - darkness * !opt_darken)) in let good_color () = html_color !opt_good_color !current_goodness in let bad_color () = html_color !opt_bad_color !current_badness 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))); @@ -210,6 +302,14 @@ let main () = ) else ( output_html_char chan loc.char ); + + if loc.bad_zero_width then ( + output_string chan (Printf.sprintf "<span style=\"background-color: %s\">" (bad_color ())); + output_string chan "«Invisible branch not taken here»"; + prerr_endline ("zero" ^ file); + output_string chan "</span>" + ); + assert (!current_goodness >= 0); assert (!current_badness >= 0) @@ -221,9 +321,34 @@ let main () = 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 + close_out chan + ) !opt_files; + + begin match !opt_index with + | Some name -> + let chan = open_out (name ^ ".html") in + + output_string chan "<!DOCTYPE html>\n"; + output_string chan "<html lang=\"en\">\n"; + Printf.ksprintf (output_string chan) + "<head>\n<meta charset=\"utf-8\">\n<title>Coverage Report</title>\n<style>%s</style>\n</head>\n" + index_css; + output_string chan "<body>\n"; + + output_string chan "<table><tr><td class=\"left\"><div class=\"scroll\">"; + List.iter (fun file -> + let _, _, desc = file_info file all taken in + Printf.ksprintf (output_string chan) "<a href=\"%s.html\" target=\"source\">%s</a><br>\n" + (Filename.remove_extension (Filename.basename file)) desc + ) !opt_files; + output_string chan "</div></td>"; + + output_string chan "<td class=\"right\"><iframe name=\"source\"></iframe></td></tr></table>\n"; + output_string chan "</body>\n"; + output_string chan "</html>"; + close_out chan + | None -> () + end let usage_msg = "usage: sailcov -t <file> -a <file> <.sail files>\n" |