[MAJOR: introduction of module ReportHTML. bisect@x9c.fr**20090502120618] { hunk ./Makefile 54 -REPORT_MODULES=reportUtils reportStat +REPORT_MODULES=reportUtils reportStat reportHTML hunk ./src/report.ml 21 -let version = "1.0-alpha" - -let html_of_stats tab s = - tab ^ "\n" ^ - tab ^ " \n" ^ - tab ^ (String.concat - ("\n" ^ tab) - (List.map - (fun (k, r) -> - Printf.sprintf " " - (Common.string_of_point_kind k) - r.ReportStat.count - r.ReportStat.total - (if r.ReportStat.total <> 0 then - string_of_int ((r.ReportStat.count * 100) / r.ReportStat.total) - else - "-")) - s)) ^ "\n" ^ - tab ^ "
kind coverage
%s %d / %d (%s %%)
\n" - -let open_both in_file out_file = - let in_channel = open_in in_file in - try - let out_channel = open_out out_file in - (in_channel, out_channel) - with e -> - close_in_noerr in_channel; - raise e - -let output_css filename = - let channel = open_out filename in - (try - let output_strings = List.iter (output_string channel) in - output_strings - [ "body {\n"; - " background: white;\n"; - " white-space: nowrap;\n"; - "}\n"; - "\n"; - ".footer {\n"; - " font-size: smaller;\n"; - " text-align: center;\n"; - "}\n"; - "\n"; - ".codeSep {\n"; - " border: none 0;\n"; - " border-top: 1px solid gray;\n"; - " height: 1px;\n"; - "}\n"; - "\n"; - ".indexSep {\n"; - " border: none 0;\n"; - " border-top: 1px solid gray;\n"; - " height: 1px;\n"; - " width: 75%;\n"; - "}\n"; - "\n"; - ".lineNone { white-space: nowrap; background: white; }\n"; - ".lineAllVisited { white-space: nowrap; background: green; }\n"; - ".lineAllUnvisited { white-space: nowrap; background: red; }\n"; - ".lineMixed { white-space: nowrap; background: yellow; }\n"; - "\n"; - "table.simple {\n"; - " border-width: 1px;\n"; - " border-spacing: 0px;\n"; - " border-top-style: solid;\n"; - " border-bottom-style: solid;\n"; - " border-color: black;\n"; - "}\n"; - "\n"; - "table.simple th {\n"; - " border-width: 1px;\n"; - " border-spacing: 0px;\n"; - " border-bottom-style: solid;\n"; - " border-color: black;\n"; - " text-align: center;\n"; - " font-weight: bold;\n"; - "}\n"; - "\n"; - "table.simple td {\n"; - " border-width: 1px;\n"; - " border-spacing: 0px;\n"; - " border-style: none;\n"; - "}\n"; - "\n"; - "table.gauge {\n"; - " border-width: 0px;\n"; - " border-spacing: 0px;\n"; - " padding: 0px;\n"; - " border-style: none;\n"; - " border-collapse: collapse;\n"; - "}\n"; - "\n"; - "table.gauge td {\n"; - " border-width: 0px;\n"; - " border-spacing: 0px;\n"; - " padding: 0px;\n"; - " border-style: none;\n"; - " border-collapse: collapse;\n"; - "}\n"; - "\n"; - ".gaugeOK { background: green; }\n"; - ".gaugeKO { background: red; }\n"; - "\n" ] - with e -> - close_out_noerr channel; - raise e); - close_out_noerr channel +type output_kind = No_output | Html_output of string hunk ./src/report.ml 23 -let html_footer = - let now = Unix.localtime (Unix.time ()) in - Printf.sprintf "Generated by Bisect %s on %d-%02d-%02d %02d:%02d:%02d" version (1900 + now.Unix.tm_year) (1 + now.Unix.tm_mon) now.Unix.tm_mday now.Unix.tm_hour now.Unix.tm_min now.Unix.tm_sec +let output = ref No_output hunk ./src/report.ml 25 -let output_html_index verbose filename l = - verbose "Writing index file ..."; - let channel = open_out filename in - (try - let output_strings = List.iter (output_string channel) in - let stats = List.fold_left (fun acc (_, _, s) -> ReportStat.add acc s) (ReportStat.make ()) l in - output_strings - [ "\n"; - " \n"; - " Bisect report\n"; - " \n"; - " \n"; - " \n"; - "

Bisect report

\n"; - "
\n"; - "
\n"; - "

Overall statistics\n"; - "

\n"; - "
\n"; - "
\n"; - "
\n"; - "

Per-file coverage\n"; - " \n"; - " coverage\n"; - "  \n"; - " file\n"; - " \n" ]; - List.iter - (fun (in_file, out_file, stats) -> - let a, b = ReportStat.summarize stats in - let x = if b = 0 then 100 else (100 * a) / b in - let y = 100 - x in - output_strings - [ " \n"; - " \n"; - " \n"; - " \n"; - " \n"; - " \n"; - "
\n"; - " \n"; - "  "; - (if b = 0 then "-" else string_of_int x); - "%
\n"; - " \n"; - "  \n"; - " "; - in_file; - ""; - "\n"; - " \n" ]) - l; - output_strings - [ " \n"; - "

\n"; - "
\n"; - "
\n"; - "
\n"; - ("

" ^ html_footer ^ "

\n"); - " \n"; - "\n" ] - with e -> - close_out_noerr channel; - raise e); - close_out_noerr channel +let verbose = ref false hunk ./src/report.ml 27 -(* split p [e1; ...; en] returns ([e1; ...; e(i-1)], [ei; ...; en]) - where i is the lowest index such that (p ei) evaluates to false *) -let split p l = - let rec spl acc = function - | hd :: tl -> - if (p hd) then - spl (hd :: acc) tl - else - (List.rev acc), (hd :: tl) - | [] -> (List.rev acc), [] in - spl [] l +let tab_size = ref 8 hunk ./src/report.ml 29 -let html_of_line tab_size line offset points = - let buff = Buffer.create (String.length line) in - let ofs = ref offset in - let pts = ref points in - let marker n = - Buffer.add_string buff "(*["; - Buffer.add_string buff (string_of_int n); - Buffer.add_string buff "]*)" in - let marker_if_any () = - match !pts with - | (o, n) :: tl when o = !ofs -> - marker n; - pts := tl - | _ -> () in - String.iter - (fun ch -> - marker_if_any (); - (match ch with - | '<' -> Buffer.add_string buff "<" - | '>' -> Buffer.add_string buff ">" - | ' ' -> Buffer.add_string buff " " - | '\"' -> Buffer.add_string buff """ - | '&' -> Buffer.add_string buff "&" - | '\t' -> for i = 1 to tab_size do Buffer.add_string buff " " done - | _ -> Buffer.add_char buff ch); - incr ofs) - line; - List.iter (fun (_, n) -> marker n) !pts; - Buffer.contents buff +let files = ref [] hunk ./src/report.ml 31 -let output_html verbose tab_size in_file out_file visited = - verbose (Printf.sprintf "Processing file '%s' ..." in_file); - let cmp_content = Common.read_points in_file in - verbose (Printf.sprintf "... file has %d points" (List.length cmp_content)); - let len = Array.length visited in - let stats = ReportStat.make () in - let pts = ref (List.map - (fun (ofs, pt, k) -> - let nb = if pt < len then visited.(pt) else 0 in - ReportStat.update stats k (nb > 0); - (ofs, nb)) - cmp_content) in - let in_channel, out_channel = open_both in_file out_file in - (try - let output_strings = List.iter (output_string out_channel) in - output_strings - [ "\n"; - " \n"; - " Bisect report\n"; - " \n"; - " \n"; - " \n"; - "

File: "; - in_file; - " (return to index)

\n"; - "
\n"; - "

Statistics:

\n"; - (html_of_stats " " stats); - "
\n"; - "

Source:

\n"; - " \n" ]; - let line_no = ref 0 in - (try - while true do - incr line_no; - let start_ofs = pos_in in_channel in - let line = input_line in_channel in - let end_ofs = pos_in in_channel in - let before, after = split (fun (o, _) -> o < end_ofs) !pts in - let line' = html_of_line tab_size line start_ofs before in - let visited, unvisited = - List.fold_left - (fun (v, u) (_, nb) -> - ((v || (nb > 0)), (u || (nb = 0)))) - (false, false) - before in - let cls = match visited, unvisited with - | false, false -> "lineNone" - | true, false -> "lineAllVisited" - | false, true -> "lineAllUnvisited" - | true, true -> "lineMixed" in - output_strings - [ ("
"); - (Printf.sprintf "%06d| " !line_no); - (if line' = "" then " " else line'); - "
\n" ]; - pts := after - done - with End_of_file -> ()); - output_strings - [ "
\n"; - "
\n"; - ("

" ^ html_footer ^ "

\n"); - " \n"; - "\n" ]; - with e -> - close_in_noerr in_channel; - close_out_noerr out_channel; - raise e); - close_in_noerr in_channel; - close_out_noerr out_channel; - stats +let add_file f = + files := f :: !files hunk ./src/report.ml 34 -type output_kind = No_output | Html_output of string +let options = [ + ("-version", + Arg.Unit (fun () -> print_endline version; exit 0), + " Print version and exit") ; + ("-verbose", + Arg.Set verbose, + " Set verbose mode") ; + ("-tab-size", + Arg.Set_int tab_size, + " Set tabulation size in output") ; + ("-html", + Arg.String (fun s -> output := Html_output s), + " Set output to html, files being written in given directory") +] hunk ./src/report.ml 50 - let output = ref No_output in - let data = Hashtbl.create 17 in - let verbose = ref false in - let tab_size = ref 8 in - Arg.parse - [ ("-version", - Arg.Unit (fun () -> print_endline version; exit 0), - " Print version and exit") ; - ("-verbose", - Arg.Set verbose, - " Set verbose mode") ; - ("-tab-size", - Arg.Set_int tab_size, - " Set tabulation size in output") ; - ("-html", - Arg.String (fun s -> output := Html_output s), - " Output html files in given directory") ] - (fun s -> - List.iter - (fun (k, arr) -> - let arr' = try (Hashtbl.find data k) +| arr with Not_found -> arr in - Hashtbl.replace data k arr') - (Common.read_runtime_data s)) - "Usage: bisect \nOptions are:"; + Arg.parse options add_file "Usage: bisect \nOptions are:"; + let data = + List.fold_right + (fun s acc -> + List.iter + (fun (k, arr) -> + let arr' = try (Hashtbl.find acc k) +| arr with Not_found -> arr in + Hashtbl.replace acc k arr') + (Common.read_runtime_data s); + acc) + !files + (Hashtbl.create 17) in hunk ./src/report.ml 64 - | No_output -> prerr_endline " *** warning: no output requested" + | No_output -> + prerr_endline " *** warning: no output requested" hunk ./src/report.ml 67 - mkdirs dir; hunk ./src/report.ml 69 - else - let files = Hashtbl.fold - (fun in_file visited acc -> - let l = List.length acc in - let basename = Printf.sprintf "file%04d.html" l in - let out_file = Filename.concat dir basename in - let stats = output_html verbose !tab_size in_file out_file visited in - (in_file, basename, stats) :: acc) - data - [] in - output_html_index verbose (Filename.concat dir "index.html") (List.sort compare files); - output_css (Filename.concat dir "style.css") + else begin + mkdirs dir; + ReportHTML.output verbose dir !tab_size data + end hunk ./src/report.ml 92 - Printf.eprintf " *** file modified since instrumentation: '%s'\n" s; + Printf.eprintf " *** source file modified since instrumentation: '%s'\n" s; addfile ./src/reportHTML.ml hunk ./src/reportHTML.ml 1 +(* + * This file is part of Bisect. + * Copyright (C) 2008-2009 Xavier Clerc. + * + * Bisect is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * Bisect is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) + +open ReportUtils + +let css = [ + "body {" ; + " background: white;" ; + " white-space: nowrap;" ; + "}" ; + "" ; + ".footer {" ; + " font-size: smaller;" ; + " text-align: center;" ; + "}" ; + "" ; + ".codeSep {" ; + " border: none 0;" ; + " border-top: 1px solid gray;" ; + " height: 1px;" ; + "}" ; + "" ; + ".indexSep {" ; + " border: none 0;" ; + " border-top: 1px solid gray;" ; + " height: 1px;" ; + " width: 75%;" ; + "}" ; + "" ; + ".lineNone { white-space: nowrap; background: white; }" ; + ".lineAllVisited { white-space: nowrap; background: green; }" ; + ".lineAllUnvisited { white-space: nowrap; background: red; }" ; + ".lineMixed { white-space: nowrap; background: yellow; }" ; + "" ; + "table.simple {" ; + " border-width: 1px;" ; + " border-spacing: 0px;" ; + " border-top-style: solid;" ; + " border-bottom-style: solid;" ; + " border-color: black;" ; + "}" ; + "" ; + "table.simple th {" ; + " border-width: 1px;" ; + " border-spacing: 0px;" ; + " border-bottom-style: solid;" ; + " border-color: black;" ; + " text-align: center;" ; + " font-weight: bold;" ; + "}" ; + "" ; + "table.simple td {" ; + " border-width: 1px;" ; + " border-spacing: 0px;" ; + " border-style: none;" ; + "}" ; + "" ; + "table.gauge {" ; + " border-width: 0px;" ; + " border-spacing: 0px;" ; + " padding: 0px;" ; + " border-style: none;" ; + " border-collapse: collapse;" ; + "}" ; + "" ; + "table.gauge td {" ; + " border-width: 0px;" ; + " border-spacing: 0px;" ; + " padding: 0px;" ; + " border-style: none;" ; + " border-collapse: collapse;" ; + "}" ; + "" ; + ".gaugeOK { background: green; }" ; + ".gaugeKO { background: red; }" ; + "" +] + +let output_css filename = + Common.try_out_channel + false + filename + (fun channel -> output_strings css [] channel) + +let html_footer = + let now = Unix.localtime (Unix.time ()) in + Printf.sprintf + "Generated by Bisect %s on %d-%02d-%02d %02d:%02d:%02d" + url + version + (1900 + now.Unix.tm_year) + (1 + now.Unix.tm_mon) + now.Unix.tm_mday + now.Unix.tm_hour + now.Unix.tm_min + now.Unix.tm_sec + +let html_of_stats s = + [ "$(tabs)" ; + "$(tabs) " ] @ + (List.map + (fun (k, r) -> + Printf.sprintf "$(tabs) " + (Common.string_of_point_kind k) + r.ReportStat.count + r.ReportStat.total + (if r.ReportStat.total <> 0 then + string_of_int ((r.ReportStat.count * 100) / r.ReportStat.total) + else + "-")) + s) @ + [ "$(tabs)
kind coverage
%s %d / %d (%s %%)
" ] + +let output_html_index verbose filename l = + verbose "Writing index file ..."; + Common.try_out_channel + false + filename + (fun channel -> + let stats = + List.fold_left + (fun acc (_, _, s) -> ReportStat.add acc s) + (ReportStat.make ()) + l in + output_strings + [ "" ; + " " ; + " Bisect report" ; + " " ; + " " ; + " " ; + "

Bisect report

" ; + "
" ; + "
" ; + "

Overall statistics

" ] + [] + channel; + output_strings + (html_of_stats stats) + ["tabs", " "] + channel; + output_strings + [ "
" ; + "
" ; + "
" ; + "
" ; + "
" ; + "

Per-file coverage

" ; + " " ; + " " ; + " " ; + " " ; + " "; + " " ] + [] + channel; + List.iter + (fun (in_file, out_file, stats) -> + let a, b = ReportStat.summarize stats in + let x = if b = 0 then 100 else (100 * a) / b in + let y = 100 - x in + output_strings + [ " " ; + " " ; + " " ; + " "; + " " ] + [ "x", string_of_int x ; + "y", string_of_int y ; + "p", (if b = 0 then "-" else string_of_int x) ; + "out_file", out_file ; + "in_file", in_file ] + channel) + l; + output_strings + [ "
coverage file
" ; + " " ; + " " ; + " " ; + " " ; + "
" ; + " " ; + "  $(p)%
" ; + "
 $(in_file)
" ; + "
" ; + "
" ; + "
" ; + "
" ; + "

$(footer)

" ; + " " ; + "" ] + ["footer", html_footer] + channel) + +let output_html verbose tab_size in_file out_file visited = + verbose (Printf.sprintf "Processing file '%s' ..." in_file); + let cmp_content = Common.read_points in_file in + verbose (Printf.sprintf "... file has %d points" (List.length cmp_content)); + let len = Array.length visited in + let stats = ReportStat.make () in + let pts = ref (List.map + (fun (ofs, pt, k) -> + let nb = if pt < len then visited.(pt) else 0 in + ReportStat.update stats k (nb > 0); + (ofs, nb)) + cmp_content) in + let in_channel, out_channel = open_both in_file out_file in + (try + output_strings + [ "" ; + " " ; + " Bisect report" ; + " " ; + " " ; + " " ; + "

File: $(in_file) (return to index)

" ; + "
" ; + "

Statistics:

" ] + [ "in_file", in_file ] + out_channel; + output_strings + (html_of_stats stats) + [ "tabs", " " ] + out_channel; + output_strings + [ "
" ; + "

Source:

" ; + " " ] + [] + out_channel; + let line_no = ref 0 in + (try + while true do + incr line_no; + let start_ofs = pos_in in_channel in + let line = input_line in_channel in + let end_ofs = pos_in in_channel in + let before, after = split (fun (o, _) -> o < end_ofs) !pts in + let line' = escape_line tab_size line start_ofs before in + let visited, unvisited = + List.fold_left + (fun (v, u) (_, nb) -> + ((v || (nb > 0)), (u || (nb = 0)))) + (false, false) + before in + let cls = match visited, unvisited with + | false, false -> "lineNone" + | true, false -> "lineAllVisited" + | false, true -> "lineAllUnvisited" + | true, true -> "lineMixed" in + output_strings + [ "
$(line_no)| $(line)
" ] + [ "cls", cls ; + "line_no", (Printf.sprintf "%06d" !line_no) ; + "line", (if line' = "" then " " else line') ] + out_channel; + pts := after + done + with End_of_file -> ()); + output_strings + [ "
" ; + "
" ; + "

$(html_footer)

" ; + " " ; + "" ] + [ "html_footer", html_footer ] + out_channel; + with e -> + close_in_noerr in_channel; + close_out_noerr out_channel; + raise e); + close_in_noerr in_channel; + close_out_noerr out_channel; + stats + +let output verbose dir tab_size data = + let files = Hashtbl.fold + (fun in_file visited acc -> + let l = List.length acc in + let basename = Printf.sprintf "file%04d.html" l in + let out_file = Filename.concat dir basename in + let stats = output_html verbose tab_size in_file out_file visited in + (in_file, basename, stats) :: acc) + data + [] in + output_html_index verbose (Filename.concat dir "index.html") (List.sort compare files); + output_css (Filename.concat dir "style.css") addfile ./src/reportHTML.mli hunk ./src/reportHTML.mli 1 +(* + * This file is part of Bisect. + * Copyright (C) 2008-2009 Xavier Clerc. + * + * Bisect is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or + * (at your option) any later version. + * + * Bisect is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) + +(** This module defines the output to HTML. *) + + +val output : (string -> unit) -> string -> int -> (string, int array) Hashtbl.t -> unit +(** [output verbose dir tab_size data] writes all the HTML files for [data] + in the directory [dir]. [verbose] is used for verbose output, and + [tab_size] is the number of space character to use as a replacement for + tabulations. *) hunk ./src/reportUtils.ml 19 +let version = "1.0-beta" + +let url = "http://bisect.x9c.fr" + hunk ./src/reportUtils.ml 50 +let split p l = + let rec spl acc l = + match l with + | hd :: tl -> + if (p hd) then + spl (hd :: acc) tl + else + (List.rev acc), l + | [] -> (List.rev acc), [] in + spl [] l + +let open_both in_file out_file = + let in_channel = open_in in_file in + try + let out_channel = open_out out_file in + (in_channel, out_channel) + with e -> + close_in_noerr in_channel; + raise e + +let output_strings lines mapping ch = + let get x = + try List.assoc x mapping with Not_found -> "" in + List.iter + (fun l -> + let buff = Buffer.create 64 in + Buffer.add_substitute buff get l; + Buffer.add_char buff '\n'; + output_string ch (Buffer.contents buff)) + lines + +let escape_line tab_size line offset points = + let buff = Buffer.create (String.length line) in + let ofs = ref offset in + let pts = ref points in + let marker n = + Buffer.add_string buff "(*["; + Buffer.add_string buff (string_of_int n); + Buffer.add_string buff "]*)" in + let marker_if_any () = + match !pts with + | (o, n) :: tl when o = !ofs -> + marker n; + pts := tl + | _ -> () in + String.iter + (fun ch -> + marker_if_any (); + (match ch with + | '<' -> Buffer.add_string buff "<" + | '>' -> Buffer.add_string buff ">" + | ' ' -> Buffer.add_string buff " " + | '\"' -> Buffer.add_string buff """ + | '&' -> Buffer.add_string buff "&" + | '\t' -> for i = 1 to tab_size do Buffer.add_string buff " " done + | _ -> Buffer.add_char buff ch); + incr ofs) + line; + List.iter (fun (_, n) -> marker n) !pts; + Buffer.contents buff + hunk ./src/reportUtils.mli 22 +val version : string +(** The Bisect version, as a string. *) + +val url : string +(** The Bisect version, as a string. *) + hunk ./src/reportUtils.mli 43 +val split : ('a -> bool) -> ('a list) -> 'a list * 'a list +(** [split p [e1; ...; en]] returns [([e1; ...; e(i-1)], [ei; ...; en])] + where is is the lowest index such that [(p ei)] evaluates to false. *) + +val open_both : string -> string -> in_channel * out_channel +(** [open_both in_file out_file] return a [(i, o)] couple where: + - [i] is an input channel for [in_file]; + - [o] is an output channel for [out_file]. *) + +val output_strings : string list -> (string * string) list -> out_channel -> unit +(** [output_strings lines mapping ch] writes the elements of [lines] + to the channel [ch]. Also substitutes {i $(xyz)} sequence as described + by [Buffer.add_substitute]. The substitution is based on the association + list [mapping]. *) + +val escape_line : int -> string -> int -> (int * int) list -> string +(** [escape_line tab_size line offset points] escape the string [line], + in such a way it can be used in HTML/XML. [tab_size] is the number + of space character to use as a replacement for tabulations. [offset] + is the offset of the start of the line, inside the file. [points] is + a list of (offset, visits) couples. *) + }