3 module List = ListLabels
5 let test_case_from_book_01 =
6 let name = "an array type and an array variable" in
11 type arrtype = array of int \
20 let open Tiger.Parser in
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;
32 let test_case_from_book_02 =
33 let name = "arr1 is valid since expression 0 is int = myint" in
39 type arrtype = array of myint \
48 let open Tiger.Parser in
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;
61 let test_case_from_book_03 =
62 let name = "a record type and a record variable" in
71 var rec1 : rectype := \
77 rec1.name := \"Somebody\"; \
83 let open Tiger.Parser in
85 TYPE; ID "rectype"; EQ;
86 LBRACE; ID "name"; COLON; ID "string";
87 COMMA; ID "age"; COLON; ID "int";
89 VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN;
91 LBRACE; ID "name"; EQ; STRING "Nobody";
92 COMMA; ID "age"; EQ; INT 1000;
95 ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON;
102 let test_case_from_book_04 =
103 let name = "define a recursive function" in
110 function nfactor(n: int): int = \
113 else n * nfactor(n-1) \
121 let open Tiger.Parser in
123 FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ;
124 IF; ID "n"; EQ; INT 0;
126 ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN;
128 ID "nfactor"; LPAREN; INT 10; RPAREN;
134 let test_case_from_book_09 =
135 let name = "error : types of then - else differ" in
139 if (5>4) then 13 else \" \" \
143 let open Tiger.Parser in
144 [ IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "
147 (* TODO: Type error test case *)
151 let test_case_from_book_queens =
154 /* A program to solve the 8-queens problem */ \n\
159 type intArray = array of int \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\
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\
174 function try(c:int) = ( \n\
175 /* for i:= 0 to c do print(\".\"); print(\"\n\"); flush();*/ \n\
177 then printboard() \n\
179 for r := 0 to N-1 \n\
181 if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 \n\
185 diag2[r+7-c] := 1; \n\
190 diag2[r+7-c] := 0 \n\
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
207 (*; test_case_from_book_queens*)
210 let tests_micro_cases =
211 let open Tiger.Parser in
244 [ID "f"; LPAREN; RPAREN]
253 [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN]
262 [ID "abc"; DOT; ID "i"]
271 [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL]
280 [ID "abc"; LBRACK; INT 0; RBRACK]
289 [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN]
296 test_cases_from_book @ tests_micro_cases
299 let tokens_of_code code =
300 let lexbuf = Lexing.from_string code in
302 let token = Tiger.Lexer.token lexbuf in
303 (* Avoiding fragile pattern-matching *)
304 if token = Tiger.Parser.EOF then [] else token :: tokens ()
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
317 Ok (Tiger.Absyn.to_string absyn)
320 let bar_sep = String.make 80 '-' in
321 let bar_end = String.make 80 '=' in
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
326 List.iteri tests ~f:(fun i (name, code, tokens_expected) ->
327 let i = i + 1 in (* Because iteri starts with 0 *)
328 printf "%s\n%sTest %d : %S\n" bar_sep (indent 0) i name;
330 printf "%sLexing : " (indent 1);
331 let tokens_emitted = tokens_of_code code in
333 assert (tokens_emitted = tokens_expected);
334 printf "%sOK%s\n" color_on_green color_off;
335 with Assert_failure _ ->
336 let tokens_to_string tokens =
337 String.concat "; " (List.map ~f:Tiger.Parser_token.to_string tokens)
340 "%sERROR%s\n%sExpected: %s\n%sEmitted : %s\n\n"
344 (tokens_to_string tokens_expected)
346 (tokens_to_string tokens_emitted)
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
356 print_endline bar_end;