From 155073e21824373c21dacbd75a61623c9d37fff2 Mon Sep 17 00:00:00 2001
From: Siraaj Khandkar <siraaj@khandkar.net>
Date: Fri, 14 Sep 2018 11:39:57 -0400
Subject: [PATCH] Tighten-up test cases: specify where errors are expected

---
 compiler/src/lib/tiger/tiger_error.ml      | 44 ++++++++++++++++++++++
 compiler/src/lib/tiger/tiger_error.mli     |  4 +-
 compiler/src/lib/tiger/tiger_test_cases.ml | 43 +++++++++++++++------
 3 files changed, 78 insertions(+), 13 deletions(-)

diff --git a/compiler/src/lib/tiger/tiger_error.ml b/compiler/src/lib/tiger/tiger_error.ml
index 70c3e3c..f49bca4 100644
--- a/compiler/src/lib/tiger/tiger_error.ml
+++ b/compiler/src/lib/tiger/tiger_error.ml
@@ -169,3 +169,47 @@ let is_unknown_id t =
   | Invalid_operand_type _
   | Different_operand_types _ ->
       false
+
+let is_unknown_type t =
+  match t with
+  | Unknown_type _ ->
+      true
+  | Unknown_id _
+  | Invalid_syntax _
+  | Id_is_a_function _
+  | Id_not_a_function _
+  | No_such_field_in_record _
+  | Exp_not_a_record _
+  | Exp_not_an_array _
+  | Wrong_type _
+  | Wrong_type_of_expression_in_var_dec _
+  | Wrong_type_used_as_array _
+  | 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
+
+let is_wrong_type t =
+  match t with
+  | Wrong_type _ ->
+      true
+  | Unknown_type _
+  | Unknown_id _
+  | Invalid_syntax _
+  | Id_is_a_function _
+  | Id_not_a_function _
+  | No_such_field_in_record _
+  | Exp_not_a_record _
+  | Exp_not_an_array _
+  | Wrong_type_of_expression_in_var_dec _
+  | Wrong_type_used_as_array _
+  | 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 eba33f2..a9d30eb 100644
--- a/compiler/src/lib/tiger/tiger_error.mli
+++ b/compiler/src/lib/tiger/tiger_error.mli
@@ -70,4 +70,6 @@ val raise : t -> 'a
 
 val to_string : t -> string
 
-val is_unknown_id : t -> bool
+val is_unknown_id   : t -> bool
+val is_unknown_type : t -> bool
+val is_wrong_type   : t -> bool
diff --git a/compiler/src/lib/tiger/tiger_test_cases.ml b/compiler/src/lib/tiger/tiger_test_cases.ml
index c7ea1fc..4902017 100644
--- a/compiler/src/lib/tiger/tiger_test_cases.ml
+++ b/compiler/src/lib/tiger/tiger_test_cases.ml
@@ -131,6 +131,7 @@ let book =
         [ IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "
         ]
       )
+      ~is_error_expected_semant:Error.is_wrong_type (* TODO: Be more specific *)
   ; Test.case
     "Book test: 8-queens"
     ~code:
@@ -190,19 +191,37 @@ let micro =
         code
         ~code
         ~out_lexing:[ID "f"; LPAREN; RPAREN]
-        ~is_error_expected_semant:Error.is_unknown_id
+        ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *)
+    )
+  ; ( let code = "abc.i" in
+      Test.case
+        code
+        ~code
+        ~out_lexing:[ID "abc"; DOT; ID "i"]
+        ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *)
+    )
+  ; ( let code = "abc[0]" in
+      Test.case
+        code
+        ~code
+        ~out_lexing:[ID "abc"; LBRACK; INT 0; RBRACK]
+        ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *)
+    )
+  ; ( let code = "abc[0] := foo()" in
+      Test.case
+        code
+        ~code
+        ~out_lexing:
+          [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN]
+        ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *)
+    )
+  ; ( let code = "abc [5] of nil" in
+      Test.case
+        code
+        ~code
+        ~out_lexing:[ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL]
+        ~is_error_expected_semant:Error.is_unknown_type (* TODO: Be more specific *)
     )
-  ; (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])
-
-  ; (let code = "abc[0] := foo()" in Test.case code ~code
-      ~out_lexing:
-        [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN])
-
-  ; (let code = "abc [5] of nil" in Test.case code ~code
-      ~out_lexing:
-        [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL])
-
   ; ( let code = "f(\"a\", 3, foo)" in
       Test.case
         code
-- 
2.20.1