2 * code |> pass_a_exe |> pass_a_out |> ... |> pass_z_exe |> pass_z_out
15 * name | pass a | ... | pass z
16 * ---------+--------+-----+--------
17 * exe foo | OK | ... | OK
18 * out foo | OK | ... | ERROR
24 module List = ListLabels
25 module String = StringLabels
30 val map : 'a t -> ('a -> 'b) -> 'b t
37 | Some x -> Some (f x)
44 : ?out_lexing : Tiger.Parser.token list
45 -> ?out_parsing : Tiger.Absyn.t
50 val run : t list -> unit
55 ; out_lexing : (Tiger.Parser.token list) option
56 ; out_parsing : Tiger.Absyn.t option
65 let color_to_ansi_code = function
67 | Yellow -> "\027[0;33m"
68 | Green -> "\027[0;32m"
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
75 let case ?(out_lexing) ?(out_parsing) ~code name =
82 let bar_sep = String.make 80 '-'
83 let bar_end = String.make 80 '='
86 let unit_spaces = 2 in
88 String.make (n * unit_spaces) ' '
90 let pass_lexing code : (Tiger.Parser.token list, string) result =
91 let lexbuf = Lexing.from_string code in
93 let token = Tiger.Lexer.token lexbuf in
94 (* Avoiding fragile pattern-matching *)
95 if token = Tiger.Parser.EOF then [] else token :: tokens ()
98 | exception e -> Error (Printexc.to_string e)
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
114 let p_ln = print_newline
115 let p_indent n = p "%s" (indent n)
118 let error_count = ref 0 in
119 let run_pass f input output : string * string =
123 ( s "%s: %s" (color Red "ERROR") (Printexc.to_string e)
128 ( s "%s: %s" (color Red "ERROR") msg
132 let exe = s "%s" (color Green "OK") in
135 Option.map output (fun expected -> expected = produced)
138 s "%s" (color Yellow "n/a")
140 s "%s" (color Green "OK")
143 s "%s" (color Red "ERROR")
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 ();
160 p "%s" bar_end; p_ln ();
161 let error_count = !error_count in
162 let clr = (if error_count = 0 then Green else Red) in
163 p "Errors: %s" (color clr (string_of_int error_count)); p_ln ();
164 p "%s" bar_end; p_ln ();
168 let test_cases_from_book =
170 "Book test 1: an array type and an array variable"
173 /* an array type and an array variable */ \
175 type arrtype = array of int \
176 var arr1:arrtype := \
183 let open Tiger.Parser in
185 TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "int";
186 VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
187 ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
194 "Book test 2: arr1 is valid since expression 0 is int = myint"
197 /* arr1 is valid since expression 0 is int = myint */ \
200 type arrtype = array of myint \
201 var arr1:arrtype := \
208 let open Tiger.Parser in
210 TYPE; ID "myint"; EQ; ID "int";
211 TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "myint";
212 VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
213 ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
220 "Book test 3: a record type and a record variable"
223 /* a record type and a record variable */ \
229 var rec1 : rectype := \
231 { name = \"Nobody\" \
235 rec1.name := \"Somebody\"; \
240 let open Tiger.Parser in
242 TYPE; ID "rectype"; EQ;
243 LBRACE; ID "name"; COLON; ID "string";
244 COMMA; ID "age"; COLON; ID "int";
246 VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN;
248 LBRACE; ID "name"; EQ; STRING "Nobody";
249 COMMA; ID "age"; EQ; INT 1000;
252 ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON;
258 "Book test 4: define a recursive function"
261 /* define a recursive function */ \
265 function nfactor(n: int): int = \
268 else n * nfactor(n-1) \
275 let open Tiger.Parser in
277 FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ;
278 IF; ID "n"; EQ; INT 0;
280 ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN;
282 ID "nfactor"; LPAREN; INT 10; RPAREN;
287 "Book test 9: error : types of then - else differ"
290 /* error : types of then - else differ */ \
291 if (5>4) then 13 else \" \" \
294 let open Tiger.Parser in
295 [ IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "
301 let test_case_from_book_queens =
304 /* A program to solve the 8-queens problem */ \n\
309 type intArray = array of int \n\
311 var row := intArray [ N ] of 0 \n\
312 var col := intArray [ N ] of 0 \n\
313 var diag1 := intArray [N+N-1] of 0 \n\
314 var diag2 := intArray [N+N-1] of 0 \n\
316 function printboard() = ( \n\
317 for i := 0 to N-1 do ( \n\
318 for j := 0 to N-1 do print(if col[i]=j then \" O\" else \" .\"); \n\
324 function try(c:int) = ( \n\
325 /* for i:= 0 to c do print(\".\"); print(\"\n\"); flush();*/ \n\
327 then printboard() \n\
329 for r := 0 to N-1 \n\
331 if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 \n\
335 diag2[r+7-c] := 1; \n\
340 diag2[r+7-c] := 0 \n\
351 let tests_micro_cases =
352 let open Tiger.Parser in
353 [ (let code = "nil" in Test.case code ~code ~out_lexing:[NIL])
354 ; (let code = "5" in Test.case code ~code ~out_lexing:[INT 5])
355 ; (let code = "-5" in Test.case code ~code ~out_lexing:[MINUS; INT 5])
356 ; (let code = "f()" in Test.case code ~code ~out_lexing:[ID "f"; LPAREN; RPAREN])
357 ; (let code = "abc.i" in Test.case code ~code ~out_lexing:[ID "abc"; DOT; ID "i"])
358 ; (let code = "abc[0]" in Test.case code ~code ~out_lexing:[ID "abc"; LBRACK; INT 0; RBRACK])
360 ; (let code = "abc[0] := foo()" in Test.case code ~code
362 [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN])
364 ; (let code = "abc [5] of nil" in Test.case code ~code
366 [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL])
368 ; (let code = "f(\"a\", 3, foo)" in Test.case code ~code
370 [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN])
374 test_cases_from_book @ tests_micro_cases