From 230eb76d7f84d3de2c824db33b6a7666e92d639f Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Tue, 19 Apr 2022 17:04:27 +0200 Subject: [PATCH] comment individual functions, print to out-channel --- test/core/shrink_benchmark.ml | 63 +++++++++++++++++++++-------------- 1 file changed, 38 insertions(+), 25 deletions(-) diff --git a/test/core/shrink_benchmark.ml b/test/core/shrink_benchmark.ml index c15d44ae..322ce5d7 100644 --- a/test/core/shrink_benchmark.ml +++ b/test/core/shrink_benchmark.ml @@ -17,6 +17,7 @@ let get_name (Test.Test cell) = Test.get_name cell (** Runners for single tests, test pairs, and test pair lists *) +(* run a single test with the given seed *) let run_timed_test seed cell = let open TestResult in let rand = Random.State.make [| seed |] in @@ -34,6 +35,7 @@ let run_timed_test seed cell = | Failed {instances} -> "fail",(List.hd instances).shrink_steps, "Failed" (* expected *) in (dur,res_str,shr_c,!shr_attempts) +(* run a pair of corresponding tests with the given seed *) let run_timed_test_pair seed (Test.Test c1, Test.Test c2) = let (dur1,res_str1,shr_c1,shr_att1) = run_timed_test seed c1 in let (dur2,res_str2,shr_c2,shr_att2) = run_timed_test seed c2 in @@ -43,53 +45,58 @@ let run_timed_test_pair seed (Test.Test c1, Test.Test c2) = let non_repeatable_tests = ["big bound issue59";"ints < 209609"] -let run_timing seeds testpairs = +(* run a list of corresponding test pairs over the given seed list *) +(* and print the benchmark result to channel [ch] *) +let run_timing ch seeds testpairs = + let fprintf = Printf.fprintf in let multiple_runs = List.length seeds > 1 in (* print iteration header - name (48 chars) *) - Printf.printf "%-48s" ""; - List.iter (fun seed -> Printf.printf " iteration seed %-7i %!" seed) seeds; - if multiple_runs then Printf.printf " total\n%!" else print_newline (); + Printf.fprintf ch "%-48s" ""; + List.iter (fun seed -> fprintf ch " iteration seed %-7i %!" seed) seeds; + if multiple_runs then fprintf ch " total\n%!" else print_newline (); (* print column header - name + 38 chars per iteration *) - Printf.printf "%-48s" "Shrink test name"; + fprintf ch "%-48s" "Shrink test name"; List.iter (fun _ -> - Printf.printf " %-6s%-10s %!" "Q1/s" "#succ/#att"; - Printf.printf " %-6s%-10s %!" "Q2/s" "#succ/#att") seeds; - if multiple_runs then Printf.printf " %6s %6s" "Q1/s" "Q2/s"; - Printf.printf "\n%!"; + fprintf ch " %-6s%-10s %!" "Q1/s" "#succ/#att"; + fprintf ch " %-6s%-10s %!" "Q2/s" "#succ/#att") seeds; + if multiple_runs then fprintf ch " %6s %6s" "Q1/s" "Q2/s"; + fprintf ch "\n%!"; (* print separator *) - Printf.printf "%s%!" (String.make 48 '-'); - List.iter (fun _ -> Printf.printf "%s%!" (String.make 38 '-')) seeds; - if multiple_runs then Printf.printf "%s%!" (String.make 16 '-'); - Printf.printf "\n%!"; + fprintf ch "%s%!" (String.make 48 '-'); + List.iter (fun _ -> fprintf ch "%s%!" (String.make 38 '-')) seeds; + if multiple_runs then fprintf ch "%s%!" (String.make 16 '-'); + fprintf ch "\n%!"; (* print timings for each test_pair and seed *) let times = List.map (fun ((test1,_test2) as test_pair) -> let name = get_name test1 in - Printf.printf "%-48s%!" name; + let max_len = 48 in + fprintf ch "%-48s%!" (if String.length name let _res_str,(dur1,shr_cnt1,shr_att1),(dur2,shr_cnt2,shr_att2) = run_timed_test_pair seed test_pair in - Printf.printf " %6.3f %4i/%-6i%!" dur1 shr_cnt1 shr_att1; - Printf.printf " %6.3f %4i/%-6i%!" dur2 shr_cnt2 shr_att2; + fprintf ch " %6.3f %4i/%-6i%!" dur1 shr_cnt1 shr_att1; + fprintf ch " %6.3f %4i/%-6i%!" dur2 shr_cnt2 shr_att2; (dur1,dur2) ) seeds in let t1_sum,t2_sum = sum_timing_pairs times in - if multiple_runs then Printf.printf " %6.3f %6.3f%!" t1_sum t2_sum; - Printf.printf "\n%!"; + if multiple_runs then fprintf ch " %6.3f %6.3f%!" t1_sum t2_sum; + fprintf ch "\n%!"; (t1_sum,t2_sum)) testpairs in let t1_sum,t2_sum = sum_timing_pairs times in - Printf.printf "%s%!" (String.make (48 + 38*List.length seeds) ' '); - Printf.printf " %6.3f %6.3f\n%!" t1_sum t2_sum + fprintf ch "%s%!" (String.make (48 + 38*List.length seeds) ' '); + fprintf ch " %6.3f %6.3f\n%!" t1_sum t2_sum +(* merge two corresponding lists of tests *) let rec merge_and_validate xs ys = match xs,ys with | [],[] -> [] | [],_ -> failwith "QCheck2_tests.Shrink has more tests than QCheck_tests.Shrink" @@ -103,7 +110,13 @@ let seeds = [1234;(*4321;*)8743;(*9876;*)6789; (*2143*) (* ouch: seed 2143 causes test "lists equal to duplication" to segfault *) ] let () = - merge_and_validate - QCheck_tests.(Shrink.tests@Function.tests) - QCheck2_tests.(Shrink.tests@Function.tests) - |> run_timing seeds + let ch = open_out "shrink_bench.log" in + try + merge_and_validate + QCheck_tests.(Shrink.tests@Function.tests) + QCheck2_tests.(Shrink.tests@Function.tests) + |> run_timing ch seeds; + close_out ch + with e -> + close_out ch; + raise e