Add a couple of type (in)compatibility test cases

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

diff --git a/compiler/src/lib/tiger/tiger_test_cases.ml b/compiler/src/lib/tiger/tiger_test_cases.ml
index 5684f73..bff7efc 100644 (file)
--- 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 =
@@ -130,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:
@@ -184,21 +186,82 @@ 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 = "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 ~code
-      ~out_lexing:
-        [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN])
+  ; ( let code = "f()" in
+      Test.case
+        code
+        ~code
+        ~out_lexing:[ID "f"; LPAREN; RPAREN]
+        ~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 = "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 code =
+        "let
+            type a = int
+            type b = a
+            type c = b
+            var i : a := 2
+            var j : c := 3
+        in
+            i := j
+        end
+        "
+      in
+      Test.case
+        "Type aliases"
+        ~code
+    )
+  ; ( let code =
+        "let
+            type a = {x:int, y:int}
+            type b = {x:int, y:int}  /* new type generated */
+            var foo : a := a {x = 1, y = 2}
+            var bar : b := b {x = 1, y = 2}
+        in
+            foo = bar  /* incompatible types */
+        end
+        "
+      in
+      Test.case
+        code
+        ~code
+                               ~is_error_expected_semant:Error.is_wrong_type (* TODO: Be more specific *)
+    )
   ]
 
 let all =