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
100 Some Error.is_cycle_in_type_dec
101 (* TODO: Be more specific - between which decs? *)
104 Some Error.is_unknown_type
105 (* TODO: Be more specific - which type? *)
109 Some Error.is_unknown_id
110 (* TODO: Be more specific - the unknown id is "i" *)
112 Some Error.is_no_such_field_in_record
113 (* TODO: Be more specific - which field? *)
115 Some Error.is_not_an_array
116 (* TODO: Be more specific *)
118 Some Error.is_not_a_record
119 (* TODO: Be more specific *)
122 Some Error.is_wrong_number_of_args
123 (* TODO: Be more specific - how many expected, how many given? *)
137 Some Error.is_wrong_type
138 (* TODO: Be more specific - what expected, what given? Where? *)
140 (* TODO: Fill-in other expected cases *)
143 let test_case_of_filename filename ~dir =
146 ~code:(read_file (Filename.concat dir filename))
147 ~out_lexing:(out_lexing_of_filename filename)
148 ~out_parsing:(out_parsing_of_filename filename)
149 ~is_error_expected_parsing:(is_error_expected_parsing_of_filename filename)
150 ~is_error_expected_semant:(is_error_expected_semant_of_filename filename)
152 let is_filename_starts_with_dot filename =
153 match filename.[0] with
154 | exception Invalid_argument _ ->
155 (* Filename should not be an empty string *)
160 let is_filename_not_hidden filename =
161 not (is_filename_starts_with_dot filename)
163 let read ~from_dir:dir =
166 |> List.filter ~f:is_filename_not_hidden
167 |> List.filter ~f:(fun filename -> Filename.check_suffix filename ".tig")
168 |> List.sort ~cmp:compare
169 |> List.map ~f:(test_case_of_filename ~dir)