| 1 | module Error = Tiger_error |
| 2 | module Test = Tiger_test |
| 3 | |
| 4 | let micro = |
| 5 | let open Tiger_parser in |
| 6 | [ (let code = "nil" in Test.case code ~code ~out_lexing:(Some [NIL])) |
| 7 | ; (let code = "5" in Test.case code ~code ~out_lexing:(Some [INT 5])) |
| 8 | ; (let code = "-5" in Test.case code ~code ~out_lexing:(Some [MINUS; INT 5])) |
| 9 | ; ( let code = "f()" in |
| 10 | Test.case |
| 11 | code |
| 12 | ~code |
| 13 | ~out_lexing:(Some [ID "f"; LPAREN; RPAREN]) |
| 14 | (* TODO: Be more specific *) |
| 15 | ~is_error_expected_semant:(Some Error.is_unknown_id) |
| 16 | ) |
| 17 | ; ( let code = "abc.i" in |
| 18 | Test.case |
| 19 | code |
| 20 | ~code |
| 21 | ~out_lexing:(Some [ID "abc"; DOT; ID "i"]) |
| 22 | (* TODO: Be more specific *) |
| 23 | ~is_error_expected_semant:(Some Error.is_unknown_id) |
| 24 | ) |
| 25 | ; ( let code = "abc[0]" in |
| 26 | Test.case |
| 27 | code |
| 28 | ~code |
| 29 | ~out_lexing:(Some [ID "abc"; LBRACK; INT 0; RBRACK]) |
| 30 | (* TODO: Be more specific *) |
| 31 | ~is_error_expected_semant:(Some Error.is_unknown_id) |
| 32 | ) |
| 33 | ; ( let code = "abc[0] := foo()" in |
| 34 | Test.case |
| 35 | code |
| 36 | ~code |
| 37 | ~out_lexing: |
| 38 | (Some [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN]) |
| 39 | (* TODO: Be more specific *) |
| 40 | ~is_error_expected_semant:(Some Error.is_unknown_id) |
| 41 | ) |
| 42 | ; ( let code = "abc [5] of nil" in |
| 43 | Test.case |
| 44 | code |
| 45 | ~code |
| 46 | ~out_lexing:(Some [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL]) |
| 47 | (* TODO: Be more specific *) |
| 48 | ~is_error_expected_semant:(Some Error.is_unknown_type) |
| 49 | ) |
| 50 | ; ( let code = "f(\"a\", 3, foo)" in |
| 51 | Test.case |
| 52 | code |
| 53 | ~code |
| 54 | ~out_lexing: |
| 55 | (Some [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN]) |
| 56 | ~is_error_expected_semant:(Some Error.is_unknown_id) |
| 57 | ) |
| 58 | ; ( Test.case |
| 59 | "Type aliases" |
| 60 | ~code: |
| 61 | "let \ |
| 62 | type a = int \ |
| 63 | type b = a \ |
| 64 | type c = b \ |
| 65 | var i : a := 2 \ |
| 66 | var j : c := 3 \ |
| 67 | in \ |
| 68 | i := j \ |
| 69 | end \ |
| 70 | " |
| 71 | ) |
| 72 | ; ( let code = |
| 73 | "let \ |
| 74 | type a = {x:int, y:int} \ |
| 75 | type b = {x:int, y:int} /* new type generated */ \ |
| 76 | var foo : a := a {x = 1, y = 2} \ |
| 77 | var bar : b := b {x = 1, y = 2} \ |
| 78 | in \ |
| 79 | foo = bar /* incompatible types */ \ |
| 80 | end \ |
| 81 | " |
| 82 | in |
| 83 | Test.case |
| 84 | "Incompatible records" |
| 85 | ~code |
| 86 | (* TODO: Be more specific *) |
| 87 | ~is_error_expected_semant:(Some Error.is_wrong_type) |
| 88 | ) |
| 89 | ; ( Test.case |
| 90 | "Recursive type def: int list" |
| 91 | ~code:"\ |
| 92 | let \n\ |
| 93 | type intlist = {hd: int, tl: intlist} \n\ |
| 94 | var lst : intlist := intlist {hd=0, tl = nil} \n\ |
| 95 | in \n\ |
| 96 | lst \n\ |
| 97 | end" |
| 98 | ) |
| 99 | ] |
| 100 | |
| 101 | let book ~dir = |
| 102 | Tiger_test_cases_book.read ~from_dir:dir |
| 103 | |
| 104 | let all ~dir = |
| 105 | (book ~dir) @ micro |