Commit | Line | Data |
---|---|---|
543d3420 SK |
1 | open Printf |
2 | ||
78c9eca5 SK |
3 | module List = ListLabels |
4 | ||
68a223c2 | 5 | let test_case_from_book_01 = |
19284c5d | 6 | let name = "an array type and an array variable" in |
78c9eca5 | 7 | let code = |
8543fc37 | 8 | " \ |
19284c5d | 9 | /* "^name^" */ \ |
8543fc37 SK |
10 | let \ |
11 | type arrtype = array of int \ | |
12 | var arr1:arrtype := \ | |
13 | arrtype [10] of 0 \ | |
14 | in \ | |
15 | arr1 \ | |
16 | end \ | |
78c9eca5 SK |
17 | " |
18 | in | |
19 | let tokens = | |
543d3420 | 20 | let open Tiger.Parser in |
78c9eca5 SK |
21 | [ LET; |
22 | TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "int"; | |
23 | VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN; | |
24 | ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0; | |
25 | IN; | |
26 | ID "arr1"; | |
27 | END | |
28 | ] | |
29 | in | |
19284c5d | 30 | (name, code, tokens) |
8543fc37 | 31 | |
68a223c2 | 32 | let test_case_from_book_02 = |
19284c5d | 33 | let name = "arr1 is valid since expression 0 is int = myint" in |
8543fc37 SK |
34 | let code = |
35 | " \ | |
19284c5d | 36 | /* "^name^" */ \ |
8543fc37 SK |
37 | let \ |
38 | type myint = int \ | |
39 | type arrtype = array of myint \ | |
b828a6e7 | 40 | var arr1:arrtype := \ |
8543fc37 SK |
41 | arrtype [10] of 0 \ |
42 | in \ | |
43 | arr1 \ | |
44 | end \ | |
45 | " | |
46 | in | |
47 | let tokens = | |
543d3420 | 48 | let open Tiger.Parser in |
8543fc37 SK |
49 | [ LET; |
50 | TYPE; ID "myint"; EQ; ID "int"; | |
51 | TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "myint"; | |
52 | VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN; | |
53 | ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0; | |
54 | IN; | |
55 | ID "arr1"; | |
56 | END | |
57 | ] | |
58 | in | |
19284c5d | 59 | (name, code, tokens) |
8543fc37 | 60 | |
68a223c2 | 61 | let test_case_from_book_03 = |
19284c5d | 62 | let name = "a record type and a record variable" in |
8543fc37 SK |
63 | let code = |
64 | " \ | |
19284c5d | 65 | /* "^name^" */ \ |
8543fc37 SK |
66 | let \ |
67 | type rectype = \ | |
68 | { name : string \ | |
69 | , age : int \ | |
70 | } \ | |
71 | var rec1 : rectype := \ | |
72 | rectype \ | |
73 | { name = \"Nobody\" \ | |
74 | , age = 1000 \ | |
75 | } \ | |
76 | in \ | |
77 | rec1.name := \"Somebody\"; \ | |
78 | rec1 \ | |
79 | end \ | |
80 | " | |
81 | in | |
82 | let tokens = | |
543d3420 | 83 | let open Tiger.Parser in |
8543fc37 SK |
84 | [ LET; |
85 | TYPE; ID "rectype"; EQ; | |
86 | LBRACE; ID "name"; COLON; ID "string"; | |
87 | COMMA; ID "age"; COLON; ID "int"; | |
88 | RBRACE; | |
89 | VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN; | |
90 | ID "rectype"; | |
91 | LBRACE; ID "name"; EQ; STRING "Nobody"; | |
92 | COMMA; ID "age"; EQ; INT 1000; | |
93 | RBRACE; | |
94 | IN; | |
95 | ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON; | |
96 | ID "rec1"; | |
97 | END | |
98 | ] | |
99 | in | |
19284c5d | 100 | (name, code, tokens) |
78c9eca5 | 101 | |
68a223c2 | 102 | let test_case_from_book_04 = |
1946b457 SK |
103 | let name = "define a recursive function" in |
104 | let code = | |
105 | " \ | |
106 | /* "^name^" */ \ | |
107 | let \ | |
108 | \ | |
109 | /* calculate n! */ \ | |
110 | function nfactor(n: int): int = \ | |
111 | if n = 0 \ | |
112 | then 1 \ | |
113 | else n * nfactor(n-1) \ | |
114 | \ | |
115 | in \ | |
116 | nfactor(10) \ | |
117 | end \ | |
118 | " | |
119 | in | |
120 | let tokens = | |
543d3420 | 121 | let open Tiger.Parser in |
1946b457 SK |
122 | [ LET; |
123 | FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ; | |
124 | IF; ID "n"; EQ; INT 0; | |
125 | THEN; INT 1; | |
126 | ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN; | |
127 | IN; | |
128 | ID "nfactor"; LPAREN; INT 10; RPAREN; | |
129 | END | |
130 | ] | |
131 | in | |
132 | (name, code, tokens) | |
133 | ||
68a223c2 | 134 | let test_case_from_book_09 = |
cb00a20d SK |
135 | let name = "error : types of then - else differ" in |
136 | let code = | |
543d3420 SK |
137 | " \ |
138 | /* "^name^" */ \ | |
139 | if (5>4) then 13 else \" \" \ | |
cb00a20d SK |
140 | " |
141 | in | |
142 | let tokens = | |
543d3420 | 143 | let open Tiger.Parser in |
cb00a20d SK |
144 | [ IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " " |
145 | ] | |
146 | in | |
147 | (* TODO: Type error test case *) | |
148 | (name, code, tokens) | |
149 | ||
15ade902 | 150 | (* |
68a223c2 | 151 | let test_case_from_book_queens = |
82e73e6c | 152 | let code = |
68a223c2 | 153 | "\ |
82e73e6c SK |
154 | /* A program to solve the 8-queens problem */ \n\ |
155 | \n\ | |
156 | let \n\ | |
157 | var N := 8 \n\ | |
158 | \n\ | |
159 | type intArray = array of int \n\ | |
160 | \n\ | |
161 | var row := intArray [ N ] of 0 \n\ | |
162 | var col := intArray [ N ] of 0 \n\ | |
163 | var diag1 := intArray [N+N-1] of 0 \n\ | |
164 | var diag2 := intArray [N+N-1] of 0 \n\ | |
165 | \n\ | |
166 | function printboard() = ( \n\ | |
167 | for i := 0 to N-1 do ( \n\ | |
168 | for j := 0 to N-1 do print(if col[i]=j then \" O\" else \" .\"); \n\ | |
169 | print(\"\n\") \n\ | |
170 | ); \n\ | |
171 | print(\"\n\") \n\ | |
172 | ) \n\ | |
173 | \n\ | |
174 | function try(c:int) = ( \n\ | |
175 | /* for i:= 0 to c do print(\".\"); print(\"\n\"); flush();*/ \n\ | |
176 | if c=N \n\ | |
177 | then printboard() \n\ | |
178 | else \n\ | |
179 | for r := 0 to N-1 \n\ | |
180 | do \n\ | |
181 | if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 \n\ | |
182 | then ( \n\ | |
183 | row[r] := 1; \n\ | |
184 | diag1[r+c] := 1; \n\ | |
185 | diag2[r+7-c] := 1; \n\ | |
186 | col[c] := r; \n\ | |
187 | try(c+1); \n\ | |
188 | row[r] := 0; \n\ | |
189 | diag1[r+c] := 0; \n\ | |
190 | diag2[r+7-c] := 0 \n\ | |
191 | ) \n\ | |
192 | ) \n\ | |
193 | in \n\ | |
194 | try(0) \n\ | |
195 | end \n\ | |
196 | " | |
197 | in | |
198 | (code, code, []) | |
15ade902 | 199 | *) |
82e73e6c | 200 | |
68a223c2 SK |
201 | let test_cases_from_book = |
202 | [ test_case_from_book_01 | |
203 | ; test_case_from_book_02 | |
204 | ; test_case_from_book_03 | |
205 | ; test_case_from_book_04 | |
206 | ; test_case_from_book_09 | |
15ade902 | 207 | (*; test_case_from_book_queens*) |
68a223c2 SK |
208 | ] |
209 | ||
210 | let tests_micro_cases = | |
211 | let open Tiger.Parser in | |
212 | [ ( | |
213 | let code = | |
214 | "nil" | |
215 | in | |
216 | let tokens = | |
217 | [NIL] | |
218 | in | |
219 | (code, code, tokens) | |
220 | ) | |
221 | ; ( | |
222 | let code = | |
223 | "5" | |
224 | in | |
225 | let tokens = | |
226 | [INT 5] | |
227 | in | |
228 | (code, code, tokens) | |
229 | ) | |
230 | ; ( | |
231 | let code = | |
232 | "-5" | |
233 | in | |
234 | let tokens = | |
235 | [MINUS; INT 5] | |
236 | in | |
237 | (code, code, tokens) | |
238 | ) | |
239 | ; ( | |
240 | let code = | |
241 | "f()" | |
242 | in | |
243 | let tokens = | |
244 | [ID "f"; LPAREN; RPAREN] | |
245 | in | |
246 | (code, code, tokens) | |
247 | ) | |
248 | ; ( | |
249 | let code = | |
250 | "f(\"a\", 3, foo)" | |
251 | in | |
252 | let tokens = | |
253 | [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN] | |
254 | in | |
255 | (code, code, tokens) | |
256 | ) | |
257 | ; ( | |
258 | let code = | |
259 | "abc.i" | |
260 | in | |
261 | let tokens = | |
262 | [ID "abc"; DOT; ID "i"] | |
263 | in | |
264 | (code, code, tokens) | |
265 | ) | |
266 | ; ( | |
267 | let code = | |
268 | "abc [5] of nil" | |
269 | in | |
270 | let tokens = | |
271 | [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL] | |
272 | in | |
273 | (code, code, tokens) | |
274 | ) | |
275 | ; ( | |
276 | let code = | |
277 | "abc[0]" | |
278 | in | |
279 | let tokens = | |
280 | [ID "abc"; LBRACK; INT 0; RBRACK] | |
281 | in | |
282 | (code, code, tokens) | |
283 | ) | |
284 | ; ( | |
285 | let code = | |
286 | "abc[0] := foo()" | |
287 | in | |
288 | let tokens = | |
289 | [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN] | |
290 | in | |
291 | (code, code, tokens) | |
292 | ) | |
78c9eca5 SK |
293 | ] |
294 | ||
68a223c2 SK |
295 | let tests = |
296 | test_cases_from_book @ tests_micro_cases | |
297 | ||
78c9eca5 | 298 | let () = |
f03690fc SK |
299 | let tokens_of_code code = |
300 | let lexbuf = Lexing.from_string code in | |
301 | let rec tokens () = | |
302 | let token = Tiger.Lexer.token lexbuf in | |
303 | (* Avoiding fragile pattern-matching *) | |
304 | if token = Tiger.Parser.EOF then [] else token :: tokens () | |
305 | in | |
306 | tokens () | |
307 | in | |
308 | let parsetree_of_code code = | |
309 | let lb = Lexing.from_string code in | |
310 | (match Tiger.Parser.program Tiger.Lexer.token lb with | |
311 | | exception Parsing.Parse_error -> | |
312 | let module L = Lexing in | |
313 | let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in | |
314 | let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in | |
315 | Error msg | |
28875fec SK |
316 | | absyn -> |
317 | Ok (Tiger.Absyn.to_string absyn) | |
f03690fc SK |
318 | ) |
319 | in | |
8543fc37 SK |
320 | let bar_sep = String.make 80 '-' in |
321 | let bar_end = String.make 80 '=' in | |
543d3420 SK |
322 | let indent n = String.make (2 * n) ' ' in |
323 | let color_on_green = "\027[0;32m" in | |
324 | let color_on_red = "\027[1;31m" in | |
325 | let color_off = "\027[0m" in | |
858f923a SK |
326 | List.iteri tests ~f:(fun i (name, code, tokens_expected) -> |
327 | let i = i + 1 in (* Because iteri starts with 0 *) | |
543d3420 SK |
328 | printf "%s\n%sTest %d : %S\n" bar_sep (indent 0) i name; |
329 | ||
330 | printf "%sLexing : " (indent 1); | |
8543fc37 SK |
331 | let tokens_emitted = tokens_of_code code in |
332 | (try | |
333 | assert (tokens_emitted = tokens_expected); | |
543d3420 | 334 | printf "%sOK%s\n" color_on_green color_off; |
8543fc37 SK |
335 | with Assert_failure _ -> |
336 | let tokens_to_string tokens = | |
543d3420 | 337 | String.concat "; " (List.map ~f:Tiger.Parser_token.to_string tokens) |
8543fc37 SK |
338 | in |
339 | printf | |
543d3420 SK |
340 | "%sERROR%s\n%sExpected: %s\n%sEmitted : %s\n\n" |
341 | color_on_red | |
342 | color_off | |
343 | (indent 2) | |
8543fc37 | 344 | (tokens_to_string tokens_expected) |
543d3420 | 345 | (indent 2) |
8543fc37 SK |
346 | (tokens_to_string tokens_emitted) |
347 | ); | |
543d3420 SK |
348 | |
349 | printf "%sParsing: " (indent 1); | |
350 | (match parsetree_of_code code with | |
351 | | Error errmsg -> printf "%sERROR:%s %s\n" color_on_red color_off errmsg | |
352 | | Ok parsetree -> printf "%sOK:%s %s\n" color_on_green color_off parsetree | |
353 | ); | |
354 | ||
8543fc37 SK |
355 | ); |
356 | print_endline bar_end; |