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: test18.tig - error : definition of recursive functions is interrupted*)
95 (* TODO: test21.tig - error : procedure returns value and procedure is used in arexpr *)
97 let is_error_expected_semant_of_filename =
98 let module E = Tiger_error in
102 Some Error.is_unknown_type
103 (* TODO: Be more specific - which type? *)
105 Some Error.is_unknown_id
106 (* TODO: Be more specific - the unknown id is "i" *)
108 Some Error.is_no_such_field_in_record
109 (* TODO: Be more specific - which field? *)
111 Some Error.is_not_an_array
112 (* TODO: Be more specific *)
114 Some Error.is_not_a_record
115 (* TODO: Be more specific *)
128 Some Error.is_wrong_type
129 (* TODO: Be more specific - what expected, what given? *)
131 (* TODO: Fill-in other expected cases *)
134 let test_case_of_filename filename ~dir =
137 ~code:(read_file (Filename.concat dir filename))
138 ~out_lexing:(out_lexing_of_filename filename)
139 ~out_parsing:(out_parsing_of_filename filename)
140 ~is_error_expected_parsing:(is_error_expected_parsing_of_filename filename)
141 ~is_error_expected_semant:(is_error_expected_semant_of_filename filename)
143 let is_filename_starts_with_dot filename =
144 match filename.[0] with
145 | exception Invalid_argument _ ->
146 (* Filename should not be an empty string *)
151 let is_filename_not_hidden filename =
152 not (is_filename_starts_with_dot filename)
154 let read ~from_dir:dir =
157 |> List.filter ~f:is_filename_not_hidden
158 |> List.filter ~f:(fun filename -> Filename.check_suffix filename ".tig")
159 |> List.sort ~cmp:compare
160 |> List.map ~f:(test_case_of_filename ~dir)