From 4c52102882d2078b418c39b99d3cfa244c66ee59 Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Fri, 4 Sep 2020 13:38:24 -0700 Subject: [PATCH] [sledge] Test: Add executable for manipulating reports Summary: Add a `sledge-report` executabe to aggregate and report results from test runs. Results from possibly-many test runs are averaged and reported in an html file with color-coded indications of performance improvement or regression. Reviewed By: ngorogiannis Differential Revision: D23459521 fbshipit-source-id: 61ca936f4 --- sledge/Makefile | 2 +- sledge/dune | 12 + sledge/nonstdlib/dune | 2 +- sledge/report/sledge_report.ml | 624 ++++++++++++++++++++++++++++++++ sledge/report/sledge_report.mli | 6 + sledge/sledge.opam | 1 + 6 files changed, 645 insertions(+), 2 deletions(-) create mode 100644 sledge/report/sledge_report.ml create mode 100644 sledge/report/sledge_report.mli diff --git a/sledge/Makefile b/sledge/Makefile index c68e7b9e0..caf5020a5 100644 --- a/sledge/Makefile +++ b/sledge/Makefile @@ -6,7 +6,7 @@ .PHONY: default default: exes -EXES = bin/sledge_cli +EXES = bin/sledge_cli report/sledge_report INSTALLS = sledge DEBUG_TARGETS = $(patsubst %,_build/debug/%.exe,$(EXES)) $(patsubst %,_build/debug/%.install,$(INSTALLS)) diff --git a/sledge/dune b/sledge/dune index 72eacd7fe..215f47aae 100644 --- a/sledge/dune +++ b/sledge/dune @@ -69,6 +69,18 @@ (pps ppx_sledge ppx_trace)) (inline_tests))) +(subdir + report + (executable + (name sledge_report) + (public_name sledge-report) + (package sledge) + (libraries sledge) + (flags + (:standard -open NS -open Sledge)) + (preprocess + (pps ppx_sledge ppx_trace)))) + (subdir src/test (library diff --git a/sledge/nonstdlib/dune b/sledge/nonstdlib/dune index 50c2daa21..4307e56a1 100644 --- a/sledge/nonstdlib/dune +++ b/sledge/nonstdlib/dune @@ -6,7 +6,7 @@ (library (name NS) (public_name nonstdlib) - (libraries core core_kernel.fheap iter zarith trace) + (libraries containers core core_kernel.fheap iter zarith trace) (flags (:standard)) (preprocess (pps ppx_sledge ppx_trace)) diff --git a/sledge/report/sledge_report.ml b/sledge/report/sledge_report.ml new file mode 100644 index 000000000..029f0389c --- /dev/null +++ b/sledge/report/sledge_report.ml @@ -0,0 +1,624 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Tbl = CCHashtbl.Make (String) + +let read filename = + let tbl = Tbl.create 64 in + List.iter (Sexp.load_sexps filename) ~f:(fun sexp -> + let {Report.name; entry} = Report.t_of_sexp sexp in + match (Tbl.find_opt tbl name, entry) with + | None, ProcessTimes (etime, ptimes) -> + Tbl.replace tbl name ([(etime, ptimes)], [], []) + | None, GcStats gc -> Tbl.replace tbl name ([], [gc], []) + | None, Status status -> Tbl.replace tbl name ([], [], [status]) + | Some (times, gcs, statuses), ProcessTimes (etime, ptimes) -> + Tbl.replace tbl name ((etime, ptimes) :: times, gcs, statuses) + | Some (times, gcs, statuses), GcStats gc -> + Tbl.replace tbl name (times, gc :: gcs, statuses) + | Some (times, gc, statuses), Status status -> + Tbl.replace tbl name (times, gc, status :: statuses) ) ; + tbl + +type times = {etime: float; utime: float; stime: float} + +type ('t, 'g) row = + { name: string + ; times: 't + ; times_deltas: 't + ; gcs: 'g + ; gcs_deltas: 'g + ; status: Report.status list + ; status_deltas: Report.status list option } + +let times_of_raw (etime, ptimes) = + let {Unix.tms_utime; tms_cutime; tms_stime; tms_cstime} = ptimes in + let utime = tms_utime +. tms_cutime in + let stime = tms_stime +. tms_cstime in + let etime = etime in + {etime; utime; stime} + +let add_time base_times row ptimes = + let tustimes = times_of_raw ptimes in + let times = tustimes :: row.times in + let times_deltas = + Option.fold base_times ~init:row.times_deltas + ~f:(fun times_deltas {etime= btt; utime= but; stime= bst} -> + let {etime= tt; utime= ut; stime= st} = tustimes in + {etime= tt -. btt; utime= ut -. but; stime= st -. bst} + :: times_deltas ) + in + {row with times; times_deltas} + +let add_times base_times times row = + if List.is_empty times then + {row with times_deltas= Option.to_list base_times} + else List.fold ~f:(add_time base_times) ~init:row times + +let add_gc base_gcs row gc = + let gcs = gc :: row.gcs in + let gcs_deltas = + Option.fold base_gcs ~init:row.gcs_deltas ~f:(fun gcs_deltas bgc -> + Report. + { allocated= gc.allocated -. bgc.allocated + ; promoted= gc.promoted -. bgc.promoted + ; peak_size= gc.peak_size -. bgc.peak_size } + :: gcs_deltas ) + in + {row with gcs; gcs_deltas} + +let add_gcs base_gcs gcs row = + if List.is_empty gcs then {row with gcs_deltas= Option.to_list base_gcs} + else List.fold ~f:(add_gc base_gcs) ~init:row gcs + +let add_status base_status row status = + if List.mem ~equal:Report.equal_status row.status status then row + else + match base_status with + | Some base_status + when not (List.mem ~equal:Report.equal_status base_status status) -> + { row with + status= status :: row.status + ; status_deltas= + Some (base_status @ Option.value row.status_deltas ~default:[]) + } + | _ -> {row with status= status :: row.status} + +let add_statuses base_status statuses row = + List.fold ~f:(add_status base_status) ~init:row statuses + +let ave_floats flts = + assert (not (Iter.is_empty flts)) ; + let min, max, sum, num = + Iter.fold flts ~init:(Float.infinity, Float.neg_infinity, 0., 0) + ~f:(fun (min, max, sum, num) flt -> + (Float.min min flt, Float.max max flt, sum +. flt, num + 1) ) + in + if num >= 5 then (sum -. min -. max) /. Float.of_int (num - 2) + else sum /. Float.of_int num + +let combine name b_result c_result = + let base_times, base_gcs, base_status = + match b_result with + | Some (times, gcs, statuses) -> + let times = + if List.is_empty times then None + else + let etimes, utimes, stimes, cutimes, cstimes = + List.fold times + ~init: + ( Iter.empty + , Iter.empty + , Iter.empty + , Iter.empty + , Iter.empty ) + ~f:(fun (etimes, utimes, stimes, cutimes, cstimes) + ( etime + , {Unix.tms_utime; tms_cutime; tms_stime; tms_cstime} ) + -> + ( Iter.cons etime etimes + , Iter.cons tms_utime utimes + , Iter.cons tms_stime stimes + , Iter.cons tms_cutime cutimes + , Iter.cons tms_cstime cstimes ) ) + in + Some + (times_of_raw + ( ave_floats etimes + , { tms_utime= ave_floats utimes + ; tms_stime= ave_floats stimes + ; tms_cutime= ave_floats cutimes + ; tms_cstime= ave_floats cstimes } )) + in + let gcs = + if List.is_empty gcs then None + else + let allocs, promos, peaks = + List.fold gcs ~init:(Iter.empty, Iter.empty, Iter.empty) + ~f:(fun (allocs, promos, peaks) + {Report.allocated; promoted; peak_size} + -> + ( Iter.cons allocated allocs + , Iter.cons promoted promos + , Iter.cons peak_size peaks ) ) + in + Some + Report. + { allocated= ave_floats allocs + ; promoted= ave_floats promos + ; peak_size= ave_floats peaks } + in + let status = + Some (List.dedup_and_sort ~compare:Report.compare_status statuses) + in + (times, gcs, status) + | None -> (None, None, None) + in + let row = + { name + ; times= [] + ; times_deltas= [] + ; gcs= [] + ; gcs_deltas= [] + ; status= [] + ; status_deltas= None } + in + match c_result with + | None -> + let times_deltas = Option.to_list base_times in + let gcs_deltas = Option.to_list base_gcs in + let status_deltas = base_status in + {row with times_deltas; gcs_deltas; status_deltas} + | Some (c_times, c_gcs, c_statuses) -> + row + |> add_times base_times c_times + |> add_gcs base_gcs c_gcs + |> add_statuses base_status c_statuses + +type ranges = + { max_time: float + ; pct_time: float + ; max_alloc: float + ; pct_alloc: float + ; max_promo: float + ; pct_promo: float + ; max_peak: float + ; pct_peak: float } + +let ranges rows = + let init = + { max_time= 0. + ; pct_time= 0. + ; max_alloc= 0. + ; pct_alloc= 0. + ; max_promo= 0. + ; pct_promo= 0. + ; max_peak= 0. + ; pct_peak= 0. } + in + Iter.fold rows ~init ~f:(fun acc {times; times_deltas; gcs; gcs_deltas} -> + Option.fold times_deltas ~init:acc ~f:(fun acc deltas -> + let max_time = Float.max acc.max_time (Float.abs deltas.etime) in + let pct_time = + Option.fold times ~init:acc.pct_time ~f:(fun pct_time times -> + let pct = 100. *. deltas.etime /. times.etime in + Float.max pct_time (Float.abs pct) ) + in + {acc with max_time; pct_time} ) + |> fun init -> + Option.fold gcs_deltas ~init ~f:(fun acc deltas -> + let max_alloc = Float.max acc.max_alloc deltas.Report.allocated in + let pct_alloc = + Option.fold gcs ~init:acc.pct_alloc ~f:(fun pct_alloc gcs -> + let pct = + 100. *. deltas.Report.allocated /. gcs.Report.allocated + in + Float.max pct_alloc (Float.abs pct) ) + in + let max_promo = Float.max acc.max_promo deltas.Report.promoted in + let pct_promo = + Option.fold gcs ~init:acc.pct_promo ~f:(fun pct_promo gcs -> + let pct = + 100. *. deltas.Report.promoted /. gcs.Report.promoted + in + Float.max pct_promo (Float.abs pct) ) + in + let max_peak = Float.max acc.max_peak deltas.Report.peak_size in + let pct_peak = + Option.fold gcs ~init:acc.pct_peak ~f:(fun pct_peak gcs -> + let pct = + 100. *. deltas.Report.peak_size /. gcs.Report.peak_size + in + Float.max pct_peak (Float.abs pct) ) + in + { acc with + max_alloc + ; pct_alloc + ; max_promo + ; pct_promo + ; max_peak + ; pct_peak } ) ) + +let color max dat = + (* linear interpolation mapping -1 to green, 0 to lace, and 1 to red *) + let green = (133., 153., 0.) in + let lace = (253., 246., 227.) in + let red = (220., 50., 47.) in + let gradient x = + let scale x (r0, g0, b0) (r1, g1, b1) = + let scale1 x c0 c1 = (x *. (c1 -. c0)) +. c0 in + (scale1 x r0 r1, scale1 x g0 g1, scale1 x b0 b1) + in + let x = Float.max (-1.) (Float.min x 1.) in + if Float.is_negative x then scale (-.x) lace green else scale x lace red + in + let rgb_to_hex (r, g, b) = + let to_int x = Int.min 255 (Int.max 0 (Float.to_int x)) in + Printf.sprintf "#%2x%2x%2x" (to_int r) (to_int g) (to_int b) + in + let rat = dat /. max in + if Float.is_nan rat then rgb_to_hex lace else rgb_to_hex (gradient rat) + +let write_html ranges rows chan = + let pf fmt = Printf.fprintf chan fmt in + pf "Test results\n" ; + pf "" ; + pf + {| + + + + + + + + + + + + + + + + + + + + + + + |} ; + Iter.iter rows ~f:(fun row -> + let {name; times; times_deltas; gcs; gcs_deltas; status; status_deltas} + = + row + in + let max_name_length = 50 in + let name = + if String.length name <= max_name_length then name + else + String.prefix name (max_name_length / 2) + ^ "…" + ^ String.suffix name (max_name_length / 2) + in + let time ppf t = + Printf.fprintf ppf + "\n" + t + in + let nondelta ppf t = + Printf.fprintf ppf "\n" t + in + let delta max pct t ppf d = + let r = 100. *. d /. t in + Printf.fprintf ppf + "\n\ + \n" + (color max d) d (color pct r) r + in + let timed = delta ranges.max_time ranges.pct_time in + let allocd = delta ranges.max_alloc ranges.pct_alloc in + let promod = delta ranges.max_promo ranges.pct_promo in + let peakd = delta ranges.max_peak ranges.pct_peak in + let pf_status ppf s = + let status_to_string = Format.asprintf "%a" Report.pp_status in + Printf.fprintf ppf "%s" (String.prefix (status_to_string s) 50) + in + let stat ppf = function + | [] -> + Printf.fprintf ppf + "\n" + | ss -> + List.iter ss ~f:(fun s -> + match (s : Report.status) with + | Safe | Unsafe _ | Ok -> + Printf.fprintf ppf + "\n" + pf_status s + | _ -> + Printf.fprintf ppf + "\n" + pf_status s ) + in + let statd ppf = function + | None | Some [] -> Printf.fprintf ppf "\n" + | Some ss -> + Printf.fprintf ppf "\n" + in + pf "" ; + pf "" name ; + ( match (times, times_deltas) with + | ( Some {etime; utime; stime} + , Some {etime= etime_delta; utime= utime_delta; stime= stime_delta} + ) -> + pf "%a%a%a%a%a%a" time etime (timed etime) etime_delta time utime + (timed utime) utime_delta time stime (timed stime) stime_delta + | Some {etime; utime; stime}, None -> + pf + "%a\n\ + %a\n\ + %a\n" + time etime time utime time stime + | None, Some {etime; utime; stime} -> + pf + "%a\n\ + %a\n\ + %a\n" + nondelta etime nondelta utime nondelta stime + | None, None -> + pf + "\n\ + \n\ + \n" ) ; + ( match (gcs, gcs_deltas) with + | ( Some {Report.allocated; promoted; peak_size} + , Some + { allocated= allocated_delta + ; promoted= promoted_delta + ; peak_size= peak_size_delta } ) -> + pf "%a%a%a%a%a%a" time allocated (allocd allocated) + allocated_delta time promoted (promod promoted) promoted_delta + time peak_size (peakd peak_size) peak_size_delta + | Some {allocated; promoted; peak_size}, None -> + pf + "%a\n\ + %a\n\ + %a\n" + time allocated time promoted time peak_size + | None, Some {allocated; promoted; peak_size} -> + pf + "%a\n\ + %a\n\ + %a\n" + nondelta allocated nondelta promoted nondelta peak_size + | None, None -> + pf + "\n\ + \n\ + \n" ) ; + pf "%a%a" stat status statd status_deltas ; + pf "\n" ) ; + pf "
Testelapsed
(sec)		Δ
Δ%%
user
(sec)		Δ
Δ%%
system
(sec)		Δ
Δ%%
alloc
(MB)		Δ
Δ%%
promo
(MB)		Δ
Δ%%
peak
(MB)		Δ
Δ%%
StatusΔ
%12.3f%12.3f%12.3f%12.2f%%%a%a" ; + List.iter ss ~f:(fun s -> Printf.fprintf ppf "%a" pf_status s) ; + Printf.fprintf ppf "
%s
\n" ; + pf "\n" + +let average row = + let ave_times times = + if List.is_empty times then None + else + let etimes, utimes, stimes = + List.fold times ~init:(Iter.empty, Iter.empty, Iter.empty) + ~f:(fun (etimes, utimes, stimes) {etime; utime; stime} -> + ( Iter.cons etime etimes + , Iter.cons utime utimes + , Iter.cons stime stimes ) ) + in + Some + { etime= ave_floats etimes + ; utime= ave_floats utimes + ; stime= ave_floats stimes } + in + let times = ave_times row.times in + let times_deltas = ave_times row.times_deltas in + let ave_gcs gcs = + if List.is_empty gcs then None + else + let alloc, promo, peak = + List.fold gcs ~init:(Iter.empty, Iter.empty, Iter.empty) + ~f:(fun (alloc, promo, peak) + {Report.allocated; promoted; peak_size} + -> + ( Iter.cons allocated alloc + , Iter.cons promoted promo + , Iter.cons peak_size peak ) ) + in + Some + Report. + { allocated= ave_floats alloc + ; promoted= ave_floats promo + ; peak_size= ave_floats peak } + in + let gcs = ave_gcs row.gcs in + let gcs_deltas = ave_gcs row.gcs_deltas in + {row with times; times_deltas; gcs; gcs_deltas} + +let add_total rows = + let init = + { name= "TOTAL" + ; times= Some {etime= 0.; utime= 0.; stime= 0.} + ; times_deltas= Some {etime= 0.; utime= 0.; stime= 0.} + ; gcs= Some {Report.allocated= 0.; promoted= 0.; peak_size= 0.} + ; gcs_deltas= Some {Report.allocated= 0.; promoted= 0.; peak_size= 0.} + ; status= [] + ; status_deltas= None } + in + let total = + Iter.fold rows ~init ~f:(fun total row -> + let times = + match (total.times, row.times) with + | Some total_times, Some row_times -> + Some + { etime= total_times.etime +. row_times.etime + ; utime= total_times.utime +. row_times.utime + ; stime= total_times.stime +. row_times.stime } + | _ -> total.times + in + let times_deltas = + match (total.times_deltas, row.times_deltas) with + | Some total_deltas, Some row_deltas -> + Some + { etime= total_deltas.etime +. row_deltas.etime + ; utime= total_deltas.utime +. row_deltas.utime + ; stime= total_deltas.stime +. row_deltas.stime } + | _ -> total.times_deltas + in + let gcs = + match (total.gcs, row.gcs) with + | Some total_gcs, Some row_gcs -> + Some + Report. + { allocated= total_gcs.allocated +. row_gcs.allocated + ; promoted= total_gcs.promoted +. row_gcs.promoted + ; peak_size= total_gcs.peak_size +. row_gcs.peak_size } + | _ -> total.gcs + in + let gcs_deltas = + match (total.gcs_deltas, row.gcs_deltas) with + | Some total_deltas, Some row_deltas -> + Some + Report. + { allocated= total_deltas.allocated +. row_deltas.allocated + ; promoted= total_deltas.promoted +. row_deltas.promoted + ; peak_size= + total_deltas.peak_size +. row_deltas.peak_size } + | _ -> total.gcs_deltas + in + let status_deltas = + if + Option.is_some total.status_deltas + || Option.is_some row.status_deltas + then Some [] + else None + in + {total with times; times_deltas; gcs; gcs_deltas; status_deltas} ) + in + Iter.cons total rows + +let cmp x y = + match (x.status_deltas, y.status_deltas) with + | Some xs, Some ys -> + List.compare Report.compare_status xs ys + |> fun o -> if o <> 0 then o else String.compare x.name y.name + | Some _, None -> -1 + | None, Some _ -> 1 + | None, None -> ( + match (x.times_deltas, y.times_deltas) with + | Some xtd, Some ytd -> Float.(compare (abs ytd.utime) (abs xtd.utime)) + | Some _, None -> 1 + | None, Some _ -> -1 + | None, None -> String.compare x.name y.name ) + +let filter rows = + Iter.filter rows ~f:(fun {status} -> + List.exists status ~f:(function Unimplemented _ -> false | _ -> true) ) + +let input_rows ?baseline current = + let b_tbl = Option.map ~f:read baseline in + let c_tbl = read current in + let names = + let keys = Tbl.keys c_tbl in + let keys = + Option.fold + ~f:(fun i t -> Iter.append (Tbl.keys t) i) + ~init:keys b_tbl + in + Iter.sort_uniq ~cmp:String.compare keys + in + Iter.map names ~f:(fun name -> + let opt_find_opt t n = Option.bind ~f:(fun t -> Tbl.find_opt t n) t in + let b_result = opt_find_opt b_tbl name in + let c_result = Tbl.find_opt c_tbl name in + combine name b_result c_result ) + +let generate_html ?baseline current output = + let rows = input_rows ?baseline current in + let rows = Iter.map ~f:average rows in + let ranges = ranges rows in + let rows = filter rows in + let rows = add_total rows in + let rows = Iter.sort ~cmp rows in + Out_channel.with_file output ~f:(write_html ranges rows) + +let html_cmd = + let open Command.Let_syntax in + let%map_open baseline = + flag "baseline" (optional string) + ~doc:" read baseline results from report " + and current = anon ("" %: string) + and output = + flag "output" (required string) + ~doc:" write html report to " + in + fun () -> generate_html ?baseline current output + +let write_status rows chan = + let rows = + Iter.filter rows ~f:(fun row -> Option.is_some row.status_deltas) + in + let rows = + Iter.sort ~cmp:(fun x y -> String.compare x.name y.name) rows + in + let ppf = Format.formatter_of_out_channel chan in + Iter.iter rows ~f:(fun {name; status; status_deltas} -> + Format.fprintf ppf "%s:\t%a%a@\n" name + (List.pp ", " Report.pp_status) + status + (Option.pp "\t%a" (List.pp ", " Report.pp_status)) + status_deltas ) + +let generate_status ?baseline current output = + let rows = input_rows ?baseline current in + match output with + | None -> write_status rows Out_channel.stdout + | Some output -> Out_channel.with_file output ~f:(write_status rows) + +let status_cmd = + let open Command.Let_syntax in + let%map_open baseline = + flag "baseline" (optional string) + ~doc:" read baseline results from report " + and current = anon ("" %: string) + and output = + flag "output" (optional string) + ~doc: + " write status report to , or to standard output if \ + omitted" + in + fun () -> generate_status ?baseline current output + +;; +Command.run + (Command.group ~summary:"SLEdge report manipulation" + [ ("html", Command.basic ~summary:"generate html report" html_cmd) + ; ("status", Command.basic ~summary:"generate status report" status_cmd) + ]) diff --git a/sledge/report/sledge_report.mli b/sledge/report/sledge_report.mli new file mode 100644 index 000000000..81857a06f --- /dev/null +++ b/sledge/report/sledge_report.mli @@ -0,0 +1,6 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) diff --git a/sledge/sledge.opam b/sledge/sledge.opam index 9a1d04b12..5c04e731a 100644 --- a/sledge/sledge.opam +++ b/sledge/sledge.opam @@ -12,6 +12,7 @@ depends: [ "ocaml" "apron" "base" + "containers" "core" {>= "v0.14"} "crunch" {build} "ctypes"