Use the same status symbol for total as for each

[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 47939df..0eafeca 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
 
@@ -46,6 +47,7 @@ type t =
   ; code        : string
   ; out_lexing  : (Tiger_parser.token list) option
   ; out_parsing : Tiger_absyn.t option
+  ; is_error_expected_parsing : (Tiger_error.t -> bool) option
   ; is_error_expected_semant : (Tiger_error.t -> bool) option
   }
 
@@ -85,7 +87,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
 
@@ -105,21 +107,10 @@ let status indicator info =
   | "" -> 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)
+    ?(is_error_expected_parsing=None)
     ?(is_error_expected_semant=None)
     ~code
     name
@@ -128,6 +119,7 @@ let case
   ; code
   ; out_lexing
   ; out_parsing
+  ; is_error_expected_parsing
   ; is_error_expected_semant
   }
 
@@ -178,14 +170,10 @@ let pass_parsing ~fake_filename ~code
   | ast ->
       Ok ast
 
-let pass_semant (absyn_opt : Tiger_absyn.t option)
+let pass_semant (absyn : Tiger_absyn.t)
 : (unit, string) result
 =
-  match absyn_opt with
-  | None ->
-      Error "AST not provided"
-  | Some absyn ->
-      Ok (Tiger_semant.transProg absyn)
+  Ok (Tiger_semant.transProg absyn)
 
 let str_exact str exact =
   let len = String.length str in
@@ -270,8 +258,8 @@ let run tests =
       | 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)
       | _ -> " "
     )))
 
@@ -291,6 +279,7 @@ let run tests =
       ; code
       ; out_lexing
       ; out_parsing
+      ; is_error_expected_parsing
       ; is_error_expected_semant
       }
     ->
@@ -305,13 +294,23 @@ let run tests =
         run_pass
           ~f:(fun () -> pass_parsing ~fake_filename:name ~code)
           ~expect_output:out_parsing
-          ~is_error_expected:None
+          ~is_error_expected:is_error_expected_parsing
       in
       let res_sem =
-        run_pass
-          ~f:(fun () -> pass_semant res_pars.out_val)
-          ~expect_output:(Some ())
-          ~is_error_expected:is_error_expected_semant
+        (* TODO: Replace this hack with general test-dependency checking *)
+        match res_pars.out_val with
+        | None ->
+            { exe_stat = Skip
+            ; exe_msg  = "No AST provided"
+            ; out_stat = Skip
+            ; out_val  = None
+            ; out_msg  = ""
+            }
+        | Some absyn ->
+            run_pass
+              ~f:(fun () -> pass_semant absyn)
+              ~expect_output:(Some ())
+              ~is_error_expected:is_error_expected_semant
       in
       let results =
         (* Replacing out_val for type compatibility *)
@@ -347,14 +346,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