Clean-up missing labels and unused entities

[tiger.ml.git] / compiler / src / lib / tiger / tiger_test.ml

diff --git a/compiler/src/lib/tiger/tiger_test.ml b/compiler/src/lib/tiger/tiger_test.ml
index 81f549d..fe84ef8 100644 (file)
--- a/compiler/src/lib/tiger/tiger_test.ml
+++ b/compiler/src/lib/tiger/tiger_test.ml
@@ -21,6 +21,7 @@
  * out foo  | OK     | ... | ERROR
  *
  * *)
+(* TODO: Perhaps a global option whether to print non-fail info? *)
 
 open Printf
 
@@ -66,8 +67,6 @@ type 'a t_result =
 type color =
   | Red
   | Red_bold
-  | Yellow
-  | Green
   | Green_bold
   | Grey_bold
 
@@ -76,8 +75,6 @@ let color_to_ansi_code = function
   | Grey_bold  -> "\027[1;30m"
   | Red        -> "\027[0;31m"
   | Red_bold   -> "\027[1;31m"
-  | Yellow     -> "\027[0;33m"
-  | Green      -> "\027[0;32m"
   | Green_bold -> "\027[1;32m"
 
 let color_off = "\027[0m"
@@ -86,7 +83,7 @@ let color color string =
   let color_on  = color_to_ansi_code color in
   sprintf "%s%s%s" color_on string color_off
 
-let colorize str = function
+let color_opt str = function
   | Some c -> (color_to_ansi_code c) ^ str ^ color_off
   | None   -> str
 
@@ -101,23 +98,6 @@ let status_to_str = function
   | Fail -> "X"
   | Skip -> "-"
 
-let status indicator info =
-  match info with
-  | "" -> indicator
-  | _  -> sprintf "%s: %s" indicator info
-
-(* TODO: Perhaps a global option whether to print non-fail info? *)
-let status_pass ?(info="") () =
-  status (color Green "P") info
-
-let status_fail ?(info="") () =
-  status (color Red "F") info
-
-let status_skip ?(info="") () =
-  (*let indicator = (color Yellow "Skip") in*)
-  let indicator = "S" in
-  status indicator info
-
 let case
     ?(out_lexing=None)
     ?(out_parsing=None)
@@ -138,11 +118,6 @@ let bar_horiz_minor = color Grey_bold (String.make 80 '-')
 let bar_horiz_major = color Grey_bold (String.make 80 '=')
 let bar_vert        = color Grey_bold "|"
 
-let indent =
-  let unit_spaces = 2 in
-  fun n ->
-    String.make (n * unit_spaces) ' '
-
 let lexbuf_set_filename lb filename
 : unit
 =
@@ -189,7 +164,7 @@ let pass_semant (absyn : Tiger_absyn.t)
 let str_exact str exact =
   let len = String.length str in
   let take = if len > exact then exact else len in
-  let str = String.sub str 0 take in
+  let str = String.sub str ~pos:0 ~len:take in
   let pad = exact - take in
   let pad = String.make pad ' ' in
   str ^ pad
@@ -197,7 +172,6 @@ let str_exact str exact =
 let s = sprintf
 let p = printf
 let p_ln = print_newline
-let p_indent n = p "%s" (indent n)
 
 let run tests =
   Printexc.record_backtrace true;
@@ -260,17 +234,16 @@ let run tests =
   in
   let test_case_count = ref 0 in
   let col_1_width = 25 in
-  let col_i_width = 10 in
   let p_stat width (exe, out) =
     (* All this gymnastics to ignore color codes in cell width *)
     let min = 5 in
     let width = if width > min then width else min in
-    p "%s" (String.concat "" (List.init ~len:width ~f:(function
+    p "%s" (String.concat ~sep:"" (List.init ~len:width ~f:(function
       | 0 -> " "
       | 1 -> bar_vert
       | 2 -> " "
-      | 3 -> colorize (status_to_str exe) (status_to_color exe)
-      | 4 -> colorize (status_to_str out) (status_to_color out)
+      | 3 -> color_opt (status_to_str exe) (status_to_color exe)
+      | 4 -> color_opt (status_to_str out) (status_to_color out)
       | _ -> " "
     )))
 
@@ -357,14 +330,13 @@ let run tests =
       );
   );
   p "%s" bar_horiz_major; p_ln ();
-  p "%s"
-    ( let info =
-        s "%d failures in %d test cases" !count_fail_all !test_case_count
-      in
-      match !count_fail_all with
-      | 0 -> status_pass () ~info
-      | _ -> status_fail () ~info
-    );
+  p "%s %d failures in %d test cases"
+      (match !count_fail_all with
+      | 0 -> color_opt (status_to_str Pass) (status_to_color Pass)
+      | _ -> color_opt (status_to_str Fail) (status_to_color Fail)
+      )
+      !count_fail_all
+      !test_case_count;
     p_ln ();
   p "%s" bar_horiz_major; p_ln ();
   exit !count_fail_all