Commit | Line | Data |
---|---|---|
543d3420 SK |
1 | open Printf |
2 | ||
78c9eca5 SK |
3 | module List = ListLabels |
4 | ||
5 | let test_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 SK |
31 | |
32 | let test_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 SK |
60 | |
61 | let test_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 | |
1946b457 SK |
102 | let test_04 = |
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 | ||
cb00a20d SK |
134 | let test_09 = |
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 | ||
78c9eca5 SK |
150 | let tests = |
151 | [ test_01 | |
8543fc37 SK |
152 | ; test_02 |
153 | ; test_03 | |
1946b457 | 154 | ; test_04 |
cb00a20d | 155 | ; test_09 |
78c9eca5 SK |
156 | ] |
157 | ||
158 | let () = | |
f03690fc SK |
159 | let tokens_of_code code = |
160 | let lexbuf = Lexing.from_string code in | |
161 | let rec tokens () = | |
162 | let token = Tiger.Lexer.token lexbuf in | |
163 | (* Avoiding fragile pattern-matching *) | |
164 | if token = Tiger.Parser.EOF then [] else token :: tokens () | |
165 | in | |
166 | tokens () | |
167 | in | |
168 | let parsetree_of_code code = | |
169 | let lb = Lexing.from_string code in | |
170 | (match Tiger.Parser.program Tiger.Lexer.token lb with | |
171 | | exception Parsing.Parse_error -> | |
172 | let module L = Lexing in | |
173 | let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in | |
174 | let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in | |
175 | Error msg | |
176 | | parsetree -> | |
177 | Ok parsetree | |
178 | ) | |
179 | in | |
8543fc37 SK |
180 | let bar_sep = String.make 80 '-' in |
181 | let bar_end = String.make 80 '=' in | |
543d3420 SK |
182 | let indent n = String.make (2 * n) ' ' in |
183 | let color_on_green = "\027[0;32m" in | |
184 | let color_on_red = "\027[1;31m" in | |
185 | let color_off = "\027[0m" in | |
858f923a SK |
186 | List.iteri tests ~f:(fun i (name, code, tokens_expected) -> |
187 | let i = i + 1 in (* Because iteri starts with 0 *) | |
543d3420 SK |
188 | printf "%s\n%sTest %d : %S\n" bar_sep (indent 0) i name; |
189 | ||
190 | printf "%sLexing : " (indent 1); | |
8543fc37 SK |
191 | let tokens_emitted = tokens_of_code code in |
192 | (try | |
193 | assert (tokens_emitted = tokens_expected); | |
543d3420 | 194 | printf "%sOK%s\n" color_on_green color_off; |
8543fc37 SK |
195 | with Assert_failure _ -> |
196 | let tokens_to_string tokens = | |
543d3420 | 197 | String.concat "; " (List.map ~f:Tiger.Parser_token.to_string tokens) |
8543fc37 SK |
198 | in |
199 | printf | |
543d3420 SK |
200 | "%sERROR%s\n%sExpected: %s\n%sEmitted : %s\n\n" |
201 | color_on_red | |
202 | color_off | |
203 | (indent 2) | |
8543fc37 | 204 | (tokens_to_string tokens_expected) |
543d3420 | 205 | (indent 2) |
8543fc37 SK |
206 | (tokens_to_string tokens_emitted) |
207 | ); | |
543d3420 SK |
208 | |
209 | printf "%sParsing: " (indent 1); | |
210 | (match parsetree_of_code code with | |
211 | | Error errmsg -> printf "%sERROR:%s %s\n" color_on_red color_off errmsg | |
212 | | Ok parsetree -> printf "%sOK:%s %s\n" color_on_green color_off parsetree | |
213 | ); | |
214 | ||
8543fc37 SK |
215 | ); |
216 | print_endline bar_end; |