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 ();
164 let test_cases_from_book =
166 "Book test 1: an array type and an array variable"
169 /* an array type and an array variable */ \
171 type arrtype = array of int \
172 var arr1:arrtype := \
179 let open Tiger.Parser in
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;
190 "Book test 2: arr1 is valid since expression 0 is int = myint"
193 /* arr1 is valid since expression 0 is int = myint */ \
196 type arrtype = array of myint \
197 var arr1:arrtype := \
204 let open Tiger.Parser in
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;
216 "Book test 3: a record type and a record variable"
219 /* a record type and a record variable */ \
225 var rec1 : rectype := \
227 { name = \"Nobody\" \
231 rec1.name := \"Somebody\"; \
236 let open Tiger.Parser in
238 TYPE; ID "rectype"; EQ;
239 LBRACE; ID "name"; COLON; ID "string";
240 COMMA; ID "age"; COLON; ID "int";
242 VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN;
244 LBRACE; ID "name"; EQ; STRING "Nobody";
245 COMMA; ID "age"; EQ; INT 1000;
248 ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON;
254 "Book test 4: define a recursive function"
257 /* define a recursive function */ \
261 function nfactor(n: int): int = \
264 else n * nfactor(n-1) \
271 let open Tiger.Parser in
273 FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ;
274 IF; ID "n"; EQ; INT 0;
276 ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN;
278 ID "nfactor"; LPAREN; INT 10; RPAREN;
283 "Book test 9: error : types of then - else differ"
286 /* error : types of then - else differ */ \
287 if (5>4) then 13 else \" \" \
290 let open Tiger.Parser in
291 [ IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "
297 let test_case_from_book_queens =
300 /* A program to solve the 8-queens problem */ \n\
305 type intArray = array of int \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\
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\
320 function try(c:int) = ( \n\
321 /* for i:= 0 to c do print(\".\"); print(\"\n\"); flush();*/ \n\
323 then printboard() \n\
325 for r := 0 to N-1 \n\
327 if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 \n\
331 diag2[r+7-c] := 1; \n\
336 diag2[r+7-c] := 0 \n\
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])
356 ; (let code = "abc[0] := foo()" in Test.case code ~code
358 [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN])
360 ; (let code = "abc [5] of nil" in Test.case code ~code
362 [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL])
364 ; (let code = "f(\"a\", 3, foo)" in Test.case code ~code
366 [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN])
370 test_cases_from_book @ tests_micro_cases