Break some long lines
[tiger.ml.git] / compiler / src / exe / tiger_tests.ml
1 (*
2 * code |> pass_a_exe |> pass_a_out |> ... |> pass_z_exe |> pass_z_out
3 *
4 * pass a:
5 * exe: OK
6 * out: n/a
7 * pass b:
8 * exe: OK
9 * out: OK
10 * pass c:
11 * exe: OK
12 * out: ERROR
13 * ...
14 *
15 * name | pass a | ... | pass z
16 * ---------+--------+-----+--------
17 * exe foo | OK | ... | OK
18 * out foo | OK | ... | ERROR
19 *
20 * *)
21
22 open Printf
23
24 module List = ListLabels
25 module String = StringLabels
26
27 module Option : sig
28 type 'a t = 'a option
29
30 val map : 'a t -> ('a -> 'b) -> 'b t
31 end = struct
32 type 'a t = 'a option
33
34 let map t f =
35 match t with
36 | None -> None
37 | Some x -> Some (f x)
38 end
39
40 module Test : sig
41 type t
42
43 val case
44 : ?out_lexing : Tiger.Parser.token list
45 -> ?out_parsing : Tiger.Absyn.t
46 -> code : string
47 -> string
48 -> t
49
50 val run : t list -> unit
51 end = struct
52 type t =
53 { name : string
54 ; code : string
55 ; out_lexing : (Tiger.Parser.token list) option
56 ; out_parsing : Tiger.Absyn.t option
57 }
58
59 type color =
60 | Red
61 | Yellow
62 | Green
63
64
65 let color_to_ansi_code = function
66 | Red -> "\027[0;31m"
67 | Yellow -> "\027[0;33m"
68 | Green -> "\027[0;32m"
69
70 let color color string =
71 let color_on = color_to_ansi_code color in
72 let color_off = "\027[0m" in
73 sprintf "%s%s%s" color_on string color_off
74
75 let case ?(out_lexing) ?(out_parsing) ~code name =
76 { name
77 ; code
78 ; out_lexing
79 ; out_parsing
80 }
81
82 let bar_sep = String.make 80 '-'
83 let bar_end = String.make 80 '='
84
85 let indent =
86 let unit_spaces = 2 in
87 fun n ->
88 String.make (n * unit_spaces) ' '
89
90 let pass_lexing code : (Tiger.Parser.token list, string) result =
91 let lexbuf = Lexing.from_string code in
92 let rec tokens () =
93 let token = Tiger.Lexer.token lexbuf in
94 (* Avoiding fragile pattern-matching *)
95 if token = Tiger.Parser.EOF then [] else token :: tokens ()
96 in
97 match tokens () with
98 | exception e -> Error (Printexc.to_string e)
99 | tokens -> Ok tokens
100
101 let pass_parsing code =
102 let lb = Lexing.from_string code in
103 match Tiger.Parser.program Tiger.Lexer.token lb with
104 | exception Parsing.Parse_error ->
105 let module L = Lexing in
106 let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in
107 let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in
108 Error msg
109 | ast ->
110 Ok ast
111
112 let s = sprintf
113 let p = printf
114 let p_ln = print_newline
115 let p_indent n = p "%s" (indent n)
116
117 let run tests =
118 let error_count = ref 0 in
119 let run_pass f input output : string * string =
120 match f input with
121 | exception e ->
122 incr error_count;
123 ( s "%s: %s" (color Red "ERROR") (Printexc.to_string e)
124 , "n/a"
125 )
126 | Error msg ->
127 incr error_count;
128 ( s "%s: %s" (color Red "ERROR") msg
129 , "n/a"
130 )
131 | Ok produced ->
132 let exe = s "%s" (color Green "OK") in
133 let out =
134 match
135 Option.map output (fun expected -> expected = produced)
136 with
137 | None ->
138 s "%s" (color Yellow "n/a")
139 | Some true ->
140 s "%s" (color Green "OK")
141 | Some false ->
142 incr error_count;
143 s "%s" (color Red "ERROR")
144 in
145 (exe, out)
146 in
147 List.iter tests ~f:(
148 fun {name; code; out_lexing; out_parsing} ->
149 let ( lexing_exe, lexing_out) = run_pass pass_lexing code out_lexing in
150 let (parsing_exe, parsing_out) = run_pass pass_parsing code out_parsing in
151 p "%s" bar_sep; p_ln ();
152 p "Test: %S" name; p_ln ();
153 p_indent 1; p "Lexing:"; p_ln ();
154 p_indent 2; p "exe: %s" lexing_exe; p_ln ();
155 p_indent 2; p "out: %s" lexing_out; p_ln ();
156 p_indent 1; p "Parsing:"; p_ln ();
157 p_indent 2; p "exe: %s" parsing_exe; p_ln ();
158 p_indent 2; p "out: %s" parsing_out; p_ln ();
159 );
160 p "%s" bar_end; p_ln ();
161 exit !error_count
162 end
163
164 let test_cases_from_book =
165 [ Test.case
166 "Book test 1: an array type and an array variable"
167 ~code:
168 " \
169 /* an array type and an array variable */ \
170 let \
171 type arrtype = array of int \
172 var arr1:arrtype := \
173 arrtype [10] of 0 \
174 in \
175 arr1 \
176 end \
177 "
178 ~out_lexing:(
179 let open Tiger.Parser in
180 [ LET;
181 TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "int";
182 VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
183 ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
184 IN;
185 ID "arr1";
186 END
187 ]
188 )
189 ; Test.case
190 "Book test 2: arr1 is valid since expression 0 is int = myint"
191 ~code:
192 " \
193 /* arr1 is valid since expression 0 is int = myint */ \
194 let \
195 type myint = int \
196 type arrtype = array of myint \
197 var arr1:arrtype := \
198 arrtype [10] of 0 \
199 in \
200 arr1 \
201 end \
202 "
203 ~out_lexing:(
204 let open Tiger.Parser in
205 [ LET;
206 TYPE; ID "myint"; EQ; ID "int";
207 TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "myint";
208 VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
209 ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
210 IN;
211 ID "arr1";
212 END
213 ]
214 )
215 ; Test.case
216 "Book test 3: a record type and a record variable"
217 ~code:
218 " \
219 /* a record type and a record variable */ \
220 let \
221 type rectype = \
222 { name : string \
223 , age : int \
224 } \
225 var rec1 : rectype := \
226 rectype \
227 { name = \"Nobody\" \
228 , age = 1000 \
229 } \
230 in \
231 rec1.name := \"Somebody\"; \
232 rec1 \
233 end \
234 "
235 ~out_lexing:(
236 let open Tiger.Parser in
237 [ LET;
238 TYPE; ID "rectype"; EQ;
239 LBRACE; ID "name"; COLON; ID "string";
240 COMMA; ID "age"; COLON; ID "int";
241 RBRACE;
242 VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN;
243 ID "rectype";
244 LBRACE; ID "name"; EQ; STRING "Nobody";
245 COMMA; ID "age"; EQ; INT 1000;
246 RBRACE;
247 IN;
248 ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON;
249 ID "rec1";
250 END
251 ]
252 )
253 ; Test.case
254 "Book test 4: define a recursive function"
255 ~code:
256 " \
257 /* define a recursive function */ \
258 let \
259 \
260 /* calculate n! */ \
261 function nfactor(n: int): int = \
262 if n = 0 \
263 then 1 \
264 else n * nfactor(n-1) \
265 \
266 in \
267 nfactor(10) \
268 end \
269 "
270 ~out_lexing:(
271 let open Tiger.Parser in
272 [ LET;
273 FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ;
274 IF; ID "n"; EQ; INT 0;
275 THEN; INT 1;
276 ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN;
277 IN;
278 ID "nfactor"; LPAREN; INT 10; RPAREN;
279 END
280 ]
281 )
282 ; Test.case
283 "Book test 9: error : types of then - else differ"
284 ~code:
285 " \
286 /* error : types of then - else differ */ \
287 if (5>4) then 13 else \" \" \
288 "
289 ~out_lexing:(
290 let open Tiger.Parser in
291 [ IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "
292 ]
293 )
294 ]
295
296 (*
297 let test_case_from_book_queens =
298 let code =
299 "\
300 /* A program to solve the 8-queens problem */ \n\
301 \n\
302 let \n\
303 var N := 8 \n\
304 \n\
305 type intArray = array of int \n\
306 \n\
307 var row := intArray [ N ] of 0 \n\
308 var col := intArray [ N ] of 0 \n\
309 var diag1 := intArray [N+N-1] of 0 \n\
310 var diag2 := intArray [N+N-1] of 0 \n\
311 \n\
312 function printboard() = ( \n\
313 for i := 0 to N-1 do ( \n\
314 for j := 0 to N-1 do print(if col[i]=j then \" O\" else \" .\"); \n\
315 print(\"\n\") \n\
316 ); \n\
317 print(\"\n\") \n\
318 ) \n\
319 \n\
320 function try(c:int) = ( \n\
321 /* for i:= 0 to c do print(\".\"); print(\"\n\"); flush();*/ \n\
322 if c=N \n\
323 then printboard() \n\
324 else \n\
325 for r := 0 to N-1 \n\
326 do \n\
327 if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 \n\
328 then ( \n\
329 row[r] := 1; \n\
330 diag1[r+c] := 1; \n\
331 diag2[r+7-c] := 1; \n\
332 col[c] := r; \n\
333 try(c+1); \n\
334 row[r] := 0; \n\
335 diag1[r+c] := 0; \n\
336 diag2[r+7-c] := 0 \n\
337 ) \n\
338 ) \n\
339 in \n\
340 try(0) \n\
341 end \n\
342 "
343 in
344 (code, code, [])
345 *)
346
347 let tests_micro_cases =
348 let open Tiger.Parser in
349 [ (let code = "nil" in Test.case code ~code ~out_lexing:[NIL])
350 ; (let code = "5" in Test.case code ~code ~out_lexing:[INT 5])
351 ; (let code = "-5" in Test.case code ~code ~out_lexing:[MINUS; INT 5])
352 ; (let code = "f()" in Test.case code ~code ~out_lexing:[ID "f"; LPAREN; RPAREN])
353 ; (let code = "abc.i" in Test.case code ~code ~out_lexing:[ID "abc"; DOT; ID "i"])
354 ; (let code = "abc[0]" in Test.case code ~code ~out_lexing:[ID "abc"; LBRACK; INT 0; RBRACK])
355
356 ; (let code = "abc[0] := foo()" in Test.case code ~code
357 ~out_lexing:
358 [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN])
359
360 ; (let code = "abc [5] of nil" in Test.case code ~code
361 ~out_lexing:
362 [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL])
363
364 ; (let code = "f(\"a\", 3, foo)" in Test.case code ~code
365 ~out_lexing:
366 [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN])
367 ]
368
369 let tests =
370 test_cases_from_book @ tests_micro_cases
371
372 let () =
373 Test.run tests
This page took 0.09528 seconds and 4 git commands to generate.