From 5da420a8c9d88111ef4ccabd6b0a0c65cddb73af Mon Sep 17 00:00:00 2001
From: Siraaj Khandkar <siraaj@khandkar.net>
Date: Thu, 13 Sep 2018 10:40:30 -0400
Subject: [PATCH] Test for semantic errors

(just 1 of, for now)
---
 compiler/src/lib/tiger/tiger_error.ml      | 16 ++++++++++++++++
 compiler/src/lib/tiger/tiger_error.mli     |  2 ++
 compiler/src/lib/tiger/tiger_test.ml       | 21 ++++++++++++++-------
 compiler/src/lib/tiger/tiger_test.mli      |  2 +-
 compiler/src/lib/tiger/tiger_test_cases.ml | 20 ++++++++++++++++----
 5 files changed, 49 insertions(+), 12 deletions(-)

diff --git a/compiler/src/lib/tiger/tiger_error.ml b/compiler/src/lib/tiger/tiger_error.ml
index 20a1f7d..ce506d9 100644
--- a/compiler/src/lib/tiger/tiger_error.ml
+++ b/compiler/src/lib/tiger/tiger_error.ml
@@ -110,3 +110,19 @@ let to_string =
         (Abs.op_show oper)
         (Typ.to_string right)
         (Pos.to_string pos)
+
+let is_unknown_id t =
+  match t with
+  | Unknown_id _ ->
+      true
+  | Invalid_syntax _
+  | Unknown_type _
+  | Id_not_a_function _
+  | Wrong_type_of_expression_in_var_dec _
+  | Wrong_type_used_as_record _
+  | Wrong_type_of_field_value _
+  | Wrong_type_of_arg _
+  | Wrong_number_of_args _
+  | Invalid_operand_type _
+  | Different_operand_types _ ->
+      false
diff --git a/compiler/src/lib/tiger/tiger_error.mli b/compiler/src/lib/tiger/tiger_error.mli
index 4009ed5..6383a62 100644
--- a/compiler/src/lib/tiger/tiger_error.mli
+++ b/compiler/src/lib/tiger/tiger_error.mli
@@ -50,3 +50,5 @@ exception T of t
 val raise : t -> 'a
 
 val to_string : t -> string
+
+val is_unknown_id : t -> bool
diff --git a/compiler/src/lib/tiger/tiger_test.ml b/compiler/src/lib/tiger/tiger_test.ml
index 12ddb22..89e317f 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 =
@@ -81,7 +81,7 @@ let status_skip ?(info="") () =
 let case
     ?(out_lexing)
     ?(out_parsing)
-    ?(is_error_expected=(fun _ -> false))
+    ?(is_error_expected_semant=(fun _ -> false))
     ~code
     name
   =
@@ -89,7 +89,7 @@ let case
   ; code
   ; out_lexing
   ; out_parsing
-  ; is_error_expected
+  ; is_error_expected_semant
   }
 
 let bar_sep = String.make 80 '-'
@@ -181,27 +181,34 @@ let run tests =
         (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, 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:is_error_expected_semant
       in
       p "%s" bar_sep; p_ln ();
       p "Test: %S" name; p_ln ();
diff --git a/compiler/src/lib/tiger/tiger_test.mli b/compiler/src/lib/tiger/tiger_test.mli
index 3f7143c..5cbc445 100644
--- a/compiler/src/lib/tiger/tiger_test.mli
+++ b/compiler/src/lib/tiger/tiger_test.mli
@@ -3,7 +3,7 @@ type t
 val case
   :  ?out_lexing  : Tiger_parser.token list
   -> ?out_parsing : Tiger_absyn.t
-  -> ?is_error_expected : (Tiger_error.t -> bool)
+  -> ?is_error_expected_semant : (Tiger_error.t -> bool)
   -> code         : string
   -> string
   -> t
diff --git a/compiler/src/lib/tiger/tiger_test_cases.ml b/compiler/src/lib/tiger/tiger_test_cases.ml
index 5684f73..c7ea1fc 100644
--- a/compiler/src/lib/tiger/tiger_test_cases.ml
+++ b/compiler/src/lib/tiger/tiger_test_cases.ml
@@ -1,3 +1,4 @@
+module Error = Tiger_error
 module Test = Tiger_test
 
 let book =
@@ -184,7 +185,13 @@ let micro =
   [ (let code = "nil"    in Test.case code ~code ~out_lexing:[NIL])
   ; (let code = "5"      in Test.case code ~code ~out_lexing:[INT 5])
   ; (let code = "-5"     in Test.case code ~code ~out_lexing:[MINUS; INT 5])
-  ; (let code = "f()"    in Test.case code ~code ~out_lexing:[ID "f"; LPAREN; RPAREN])
+  ; ( let code = "f()" in
+      Test.case
+        code
+        ~code
+        ~out_lexing:[ID "f"; LPAREN; RPAREN]
+        ~is_error_expected_semant:Error.is_unknown_id
+    )
   ; (let code = "abc.i"  in Test.case code ~code ~out_lexing:[ID "abc"; DOT; ID "i"])
   ; (let code = "abc[0]" in Test.case code ~code ~out_lexing:[ID "abc"; LBRACK; INT 0; RBRACK])
 
@@ -196,9 +203,14 @@ let micro =
       ~out_lexing:
         [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL])
 
-  ; (let code = "f(\"a\", 3, foo)" in Test.case code ~code
-      ~out_lexing:
-        [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN])
+  ; ( let code = "f(\"a\", 3, foo)" in
+      Test.case
+        code
+        ~code
+        ~out_lexing:
+          [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN]
+        ~is_error_expected_semant:Error.is_unknown_id
+    )
   ]
 
 let all =
-- 
2.20.1