X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=compiler%2Fsrc%2Flib%2Ftiger%2Ftiger_test.ml;h=89376a38ad4044cd1676d93845acd2643176fc3e;hb=b762cacb0f9df0b034bb75e67c4b64151e338e92;hp=83e9890584aaca794051ef06291bd91e549f30f3;hpb=df6377392ff2959a614242615a1dda51f5b97176;p=tiger.ml.git

diff --git a/compiler/src/lib/tiger/tiger_test.ml b/compiler/src/lib/tiger/tiger_test.ml
index 83e9890..89376a3 100644
--- a/compiler/src/lib/tiger/tiger_test.ml
+++ b/compiler/src/lib/tiger/tiger_test.ml
@@ -45,7 +45,7 @@ type t =
   ; code        : string
   ; out_lexing  : (Tiger_parser.token list) option
   ; out_parsing : Tiger_absyn.t option
-  ; is_error_expected : (Tiger_error.t -> bool)
+  ; is_error_expected_semant : (Tiger_error.t -> bool)
   }
 
 type color =
@@ -64,10 +64,24 @@ let color color string =
   let color_off = "\027[0m" in
   sprintf "%s%s%s" color_on string color_off
 
+let status indicator info =
+  match info with
+  | "" -> indicator
+  | _  -> sprintf "%s: %s" indicator info
+
+let status_pass ?(info="") () =
+  status (color Green "Pass") info
+
+let status_fail ?(info="") () =
+  status (color Red "Fail") info
+
+let status_skip ?(info="") () =
+  status (color Yellow "Skip") info
+
 let case
     ?(out_lexing)
     ?(out_parsing)
-    ?(is_error_expected=(fun _ -> false))
+    ?(is_error_expected_semant=(fun _ -> false))
     ~code
     name
   =
@@ -75,7 +89,7 @@ let case
   ; code
   ; out_lexing
   ; out_parsing
-  ; is_error_expected
+  ; is_error_expected_semant
   }
 
 let bar_sep = String.make 80 '-'
@@ -108,72 +122,93 @@ let pass_parsing code : (Tiger_absyn.t, string) result =
   | ast ->
       Ok ast
 
+let pass_semant (absyn_opt : Tiger_absyn.t option) : (unit, string) result =
+  match absyn_opt with
+  | None ->
+      Error "AST not provided"
+  | Some absyn ->
+      Ok (Tiger_semant.transProg absyn)
+
 let s = sprintf
 let p = printf
 let p_ln = print_newline
 let p_indent n = p "%s" (indent n)
 
 let run tests =
-  let error_count = ref 0 in
+  let failure_count = ref 0 in
   let run_pass ~f ~input ~expect_output ~is_error_expected =
     let output_status = "n/a" in
     let output_value  = None in
     match f input with
     | exception e ->
-        let status_text, error_text =
+        let execution_status =
           (match e with
           | Tiger_error.T e when is_error_expected e ->
-              ((color Green "OK"), Tiger_error.to_string e)
+              status_pass () ~info:(Tiger_error.to_string e)
           | Tiger_error.T e ->
-              incr error_count;
-              ((color Red "ERROR"), Tiger_error.to_string e)
+              incr failure_count;
+              status_fail () ~info:(Tiger_error.to_string e)
           | e ->
-              incr error_count;
-              ((color Red "ERROR"), Printexc.to_string e)
+              incr failure_count;
+              status_fail () ~info:(Printexc.to_string e)
           )
         in
-        ( s "%s: %s" status_text error_text
+        ( execution_status
         , output_status
         , output_value
         )
-    | Error msg ->
-        incr error_count;
-        ( s "%s: %s" (color Red "ERROR") msg
+    | Error info ->
+        incr failure_count;
+        ( status_fail ~info ()
         , output_status
         , output_value
         )
     | Ok produced ->
-        let execution_status = s "%s" (color Green "OK") in
+        let execution_status = status_pass () in
         let output_status =
           match
             Option.map expect_output (fun expected -> expected = produced)
           with
           | None ->
-              s "%s" (color Yellow "expected output not provided")
+              status_skip () ~info:"expected output not provided"
           | Some true ->
-              s "%s" (color Green "OK")
+              status_pass ()
           | Some false ->
-              incr error_count;
-              s "%s" (color Red "ERROR")
+              incr failure_count;
+              status_fail ()
         in
         let output_value = Some produced in
         (execution_status, output_status, output_value)
   in
   List.iter tests ~f:(
-    fun {name; code; out_lexing; out_parsing; is_error_expected} ->
+    fun
+      { name
+      ; code
+      ; out_lexing
+      ; out_parsing
+      ; is_error_expected_semant
+      }
+    ->
       let (stat_lex_exe, stat_lex_out_cmp, _) =
         run_pass
           ~f:pass_lexing
           ~input:code
           ~expect_output:out_lexing
-          ~is_error_expected
+          ~is_error_expected:(fun _ -> false)
       in
-      let (stat_pars_exe, stat_pars_out_cmp, _) =
+      let (stat_pars_exe, stat_pars_out_cmp, absyn_opt) =
         run_pass
           ~f:pass_parsing
           ~input:code
           ~expect_output:out_parsing
-          ~is_error_expected
+          ~is_error_expected:(fun _ -> false)
+      in
+      let (stat_semant_exe, stat_semant_out_cmp, _) =
+        run_pass
+          ~f:pass_semant
+          ~input:absyn_opt
+          ~expect_output:(Some ())
+          ~is_error_expected:is_error_expected_semant
       in
       p "%s" bar_sep; p_ln ();
       p "Test: %S" name; p_ln ();
@@ -183,10 +218,16 @@ let run tests =
         p_indent 1; p "Parsing:"; p_ln ();
           p_indent 2; p "exe: %s" stat_pars_exe    ; p_ln ();
           p_indent 2; p "out: %s" stat_pars_out_cmp; p_ln ();
+        p_indent 1; p "Semantic Analysis:"; p_ln ();
+          p_indent 2; p "exe: %s" stat_semant_exe    ; p_ln ();
+          p_indent 2; p "out: %s" stat_semant_out_cmp; p_ln ();
   );
   p "%s" bar_end; p_ln ();
-  let failures = !error_count in
-  let clr = (if failures = 0 then Green else Red) in
-  p "Failures: %s" (color clr (string_of_int failures)); p_ln ();
+  p "%s"
+    (match !failure_count with
+    | 0 -> status_pass ()
+    | _ -> status_fail () ~info:(s "%d failures" !failure_count)
+    );
+    p_ln ();
   p "%s" bar_end; p_ln ();
-  exit failures
+  exit !failure_count