1 module List = ListLabels
3 module Error = Tiger_error
4 module Test = Tiger_test
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
12 Buffer.add_channel buf ic size;
21 let out_lexing_of_filename =
22 let open Tiger_parser in
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;
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;
48 TYPE; ID "rectype"; EQ;
49 LBRACE; ID "name"; COLON; ID "string";
50 COMMA; ID "age"; COLON; ID "int";
52 VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN;
54 LBRACE; ID "name"; EQ; STRING "Nobody";
55 COMMA; ID "age"; EQ; INT 1000;
58 ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON;
65 FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ;
66 IF; ID "n"; EQ; INT 0;
68 ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN;
70 ID "nfactor"; LPAREN; INT 10; RPAREN;
75 [IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "]
77 (* TODO: Fill-in other expected cases *)
80 let out_parsing_of_filename _ =
81 (* TODO: Fill-in expected cases *)
84 let is_error_expected_parsing_of_filename =
85 let module E = Tiger_error in
88 Some Error.is_invalid_syntax
89 (* TODO: Be more specific - test position *)
91 (* TODO: Fill-in other expected cases *)
94 (* TODO: test21.tig - error : procedure returns value and procedure is used in arexpr *)
96 let is_error_expected_semant_of_filename =
97 let module E = Tiger_error in
101 Some Error.is_unknown_type
102 (* TODO: Be more specific - which type? *)
106 Some Error.is_unknown_id
107 (* TODO: Be more specific - the unknown id is "i" *)
109 Some Error.is_no_such_field_in_record
110 (* TODO: Be more specific - which field? *)
112 Some Error.is_not_an_array
113 (* TODO: Be more specific *)
115 Some Error.is_not_a_record
116 (* TODO: Be more specific *)
119 Some Error.is_wrong_number_of_args
120 (* TODO: Be more specific - how many expected, how many given? *)
134 Some Error.is_wrong_type
135 (* TODO: Be more specific - what expected, what given? Where? *)
137 (* TODO: Fill-in other expected cases *)
140 let test_case_of_filename filename ~dir =
143 ~code:(read_file (Filename.concat dir filename))
144 ~out_lexing:(out_lexing_of_filename filename)
145 ~out_parsing:(out_parsing_of_filename filename)
146 ~is_error_expected_parsing:(is_error_expected_parsing_of_filename filename)
147 ~is_error_expected_semant:(is_error_expected_semant_of_filename filename)
149 let is_filename_starts_with_dot filename =
150 match filename.[0] with
151 | exception Invalid_argument _ ->
152 (* Filename should not be an empty string *)
157 let is_filename_not_hidden filename =
158 not (is_filename_starts_with_dot filename)
160 let read ~from_dir:dir =
163 |> List.filter ~f:is_filename_not_hidden
164 |> List.filter ~f:(fun filename -> Filename.check_suffix filename ".tig")
165 |> List.sort ~cmp:compare
166 |> List.map ~f:(test_case_of_filename ~dir)