Expect some of the type errors in book tests
[tiger.ml.git] / compiler / src / lib / tiger / tiger_test_cases_book.ml
1 module List = ListLabels
2
3 module Error = Tiger_error
4 module Test = Tiger_test
5
6 let read_file filepath =
7 let {Unix.st_size=size; _} = Unix.stat filepath in
8 let buf = Buffer.create size in
9 let ic = open_in filepath in
10 let rec read () =
11 try
12 Buffer.add_channel buf ic size;
13 read ()
14 with End_of_file ->
15 ()
16 in
17 read ();
18 close_in ic;
19 Buffer.contents buf
20
21 let out_lexing_of_filename =
22 let open Tiger_parser in
23 function
24 | "test01.tig" ->
25 Some
26 [ LET;
27 TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "int";
28 VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
29 ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
30 IN;
31 ID "arr1";
32 END
33 ]
34 | "test02.tig" ->
35 Some
36 [ LET;
37 TYPE; ID "myint"; EQ; ID "int";
38 TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "myint";
39 VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
40 ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
41 IN;
42 ID "arr1";
43 END
44 ]
45 | "test03.tig" ->
46 Some
47 [ LET;
48 TYPE; ID "rectype"; EQ;
49 LBRACE; ID "name"; COLON; ID "string";
50 COMMA; ID "age"; COLON; ID "int";
51 RBRACE;
52 VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN;
53 ID "rectype";
54 LBRACE; ID "name"; EQ; STRING "Nobody";
55 COMMA; ID "age"; EQ; INT 1000;
56 RBRACE;
57 IN;
58 ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON;
59 ID "rec1";
60 END
61 ]
62 | "test04.tig" ->
63 Some
64 [ LET;
65 FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ;
66 IF; ID "n"; EQ; INT 0;
67 THEN; INT 1;
68 ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN;
69 IN;
70 ID "nfactor"; LPAREN; INT 10; RPAREN;
71 END
72 ]
73 | "test09.tig" ->
74 Some
75 [IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "]
76 | _ ->
77 (* TODO: Fill-in other expected cases *)
78 None
79
80 let out_parsing_of_filename _ =
81 (* TODO: Fill-in expected cases *)
82 None
83
84 let is_error_expected_parsing_of_filename =
85 let module E = Tiger_error in
86 function
87 | "test49.tig" ->
88 Some (function E.Invalid_syntax _ -> true | _ -> false)
89 (* TODO: Be more specific - test position *)
90 | _ ->
91 (* TODO: Fill-in other expected cases *)
92 None
93
94 (* TODO test21.tig - error : procedure returns value and procedure is used in arexpr *)
95 (* TODO test22.tig - No_such_field_in_record *)
96 (* TODO test24.tig - Exp_not_an_array *)
97 (* TODO test25.tig - Exp_not_a_record *)
98
99 let is_error_expected_semant_of_filename =
100 let module E = Tiger_error in
101 function
102 | "test09.tig"
103 | "test23.tig"
104 | "test26.tig"
105 | "test28.tig"
106 | "test29.tig"
107 | "test31.tig"
108 | "test32.tig"
109 | "test34.tig"
110 | "test43.tig" ->
111 Some Error.is_wrong_type
112 (* TODO: Be more specific - what expected, what given? *)
113 | _ ->
114 (* TODO: Fill-in other expected cases *)
115 None
116
117 let test_case_of_filename filename ~dir =
118 Test.case
119 filename
120 ~code:(read_file (Filename.concat dir filename))
121 ~out_lexing:(out_lexing_of_filename filename)
122 ~out_parsing:(out_parsing_of_filename filename)
123 ~is_error_expected_parsing:(is_error_expected_parsing_of_filename filename)
124 ~is_error_expected_semant:(is_error_expected_semant_of_filename filename)
125
126 let read ~from_dir:dir =
127 Sys.readdir dir
128 |> Array.to_list
129 |> List.sort ~cmp:compare
130 |> List.map ~f:(test_case_of_filename ~dir)
This page took 0.08058 seconds and 4 git commands to generate.