Add option iter
[tiger.ml.git] / compiler / src / lib / tiger / tiger_test_cases_book.ml
CommitLineData
38ffcb1f
SK
1module List = ListLabels
2
c0b10ff1 3module Error = Tiger_error
38ffcb1f
SK
4module Test = Tiger_test
5
6let 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
21let 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
80let out_parsing_of_filename _ =
81 (* TODO: Fill-in expected cases *)
82 None
83
89037894
SK
84let is_error_expected_parsing_of_filename =
85 let module E = Tiger_error in
86 function
87 | "test49.tig" ->
789ef466 88 Some Error.is_invalid_syntax
89037894
SK
89 (* TODO: Be more specific - test position *)
90 | _ ->
91 (* TODO: Fill-in other expected cases *)
92 None
93
1d155dc1 94(* TODO: test21.tig - error : procedure returns value and procedure is used in arexpr *)
354b4e33 95
c0b10ff1
SK
96let is_error_expected_semant_of_filename =
97 let module E = Tiger_error in
98 function
e6e82c08
SK
99 | "test16.tig" ->
100 Some Error.is_cycle_in_type_dec
101 (* TODO: Be more specific - between which decs? *)
1d155dc1
SK
102 | "test17.tig"
103 | "test33.tig" ->
80c3c410
SK
104 Some Error.is_unknown_type
105 (* TODO: Be more specific - which type? *)
a284f5c2
SK
106 | "test18.tig"
107 | "test19.tig"
1d155dc1
SK
108 | "test20.tig" ->
109 Some Error.is_unknown_id
110 (* TODO: Be more specific - the unknown id is "i" *)
111 | "test22.tig" ->
112 Some Error.is_no_such_field_in_record
113 (* TODO: Be more specific - which field? *)
114 | "test24.tig" ->
115 Some Error.is_not_an_array
116 (* TODO: Be more specific *)
117 | "test25.tig" ->
118 Some Error.is_not_a_record
119 (* TODO: Be more specific *)
54e838f4
SK
120 | "test35.tig"
121 | "test36.tig" ->
122 Some Error.is_wrong_number_of_args
123 (* TODO: Be more specific - how many expected, how many given? *)
354b4e33 124 | "test09.tig"
80c3c410
SK
125 | "test11.tig"
126 | "test13.tig"
127 | "test14.tig"
a284f5c2 128 | "test21.tig"
354b4e33
SK
129 | "test23.tig"
130 | "test26.tig"
131 | "test28.tig"
132 | "test29.tig"
133 | "test31.tig"
134 | "test32.tig"
135 | "test34.tig"
c0b10ff1
SK
136 | "test43.tig" ->
137 Some Error.is_wrong_type
a284f5c2 138 (* TODO: Be more specific - what expected, what given? Where? *)
c0b10ff1
SK
139 | _ ->
140 (* TODO: Fill-in other expected cases *)
141 None
38ffcb1f
SK
142
143let test_case_of_filename filename ~dir =
144 Test.case
145 filename
146 ~code:(read_file (Filename.concat dir filename))
147 ~out_lexing:(out_lexing_of_filename filename)
148 ~out_parsing:(out_parsing_of_filename filename)
89037894 149 ~is_error_expected_parsing:(is_error_expected_parsing_of_filename filename)
38ffcb1f
SK
150 ~is_error_expected_semant:(is_error_expected_semant_of_filename filename)
151
f7fa9b32
SK
152let is_filename_starts_with_dot filename =
153 match filename.[0] with
154 | exception Invalid_argument _ ->
155 (* Filename should not be an empty string *)
156 assert false
157 | '.' -> true
158 | _ -> false
159
160let is_filename_not_hidden filename =
161 not (is_filename_starts_with_dot filename)
162
38ffcb1f
SK
163let read ~from_dir:dir =
164 Sys.readdir dir
165 |> Array.to_list
f7fa9b32 166 |> List.filter ~f:is_filename_not_hidden
c09092a9 167 |> List.filter ~f:(fun filename -> Filename.check_suffix filename ".tig")
38ffcb1f
SK
168 |> List.sort ~cmp:compare
169 |> List.map ~f:(test_case_of_filename ~dir)
This page took 0.047393 seconds and 4 git commands to generate.