Commit | Line | Data |
---|---|---|
e69e4e8b SK |
1 | (* "exe" is for status of execution (whether any exceptions were raised) |
2 | * "out" is for status of output comparison (whether what was outputted is | |
3 | * what was expected) | |
4 | * | |
d3bdde4b SK |
5 | * code |> pass_a_exe |> pass_a_out |> ... |> pass_z_exe |> pass_z_out |
6 | * | |
7 | * pass a: | |
8 | * exe: OK | |
9 | * out: n/a | |
10 | * pass b: | |
11 | * exe: OK | |
12 | * out: OK | |
13 | * pass c: | |
14 | * exe: OK | |
15 | * out: ERROR | |
16 | * ... | |
17 | * | |
18 | * name | pass a | ... | pass z | |
19 | * ---------+--------+-----+-------- | |
20 | * exe foo | OK | ... | OK | |
21 | * out foo | OK | ... | ERROR | |
22 | * | |
23 | * *) | |
24 | ||
25 | open Printf | |
26 | ||
27 | module List = ListLabels | |
28 | module String = StringLabels | |
29 | ||
30 | module Option : sig | |
31 | type 'a t = 'a option | |
32 | ||
33 | val map : 'a t -> ('a -> 'b) -> 'b t | |
34 | end = struct | |
35 | type 'a t = 'a option | |
36 | ||
37 | let map t f = | |
38 | match t with | |
39 | | None -> None | |
40 | | Some x -> Some (f x) | |
41 | end | |
42 | ||
43 | type t = | |
44 | { name : string | |
45 | ; code : string | |
46 | ; out_lexing : (Tiger_parser.token list) option | |
47 | ; out_parsing : Tiger_absyn.t option | |
5da420a8 | 48 | ; is_error_expected_semant : (Tiger_error.t -> bool) |
d3bdde4b SK |
49 | } |
50 | ||
51 | type color = | |
52 | | Red | |
53 | | Yellow | |
54 | | Green | |
55 | ||
56 | ||
57 | let color_to_ansi_code = function | |
58 | | Red -> "\027[0;31m" | |
59 | | Yellow -> "\027[0;33m" | |
60 | | Green -> "\027[0;32m" | |
61 | ||
62 | let color color string = | |
63 | let color_on = color_to_ansi_code color in | |
64 | let color_off = "\027[0m" in | |
65 | sprintf "%s%s%s" color_on string color_off | |
66 | ||
39dd0869 SK |
67 | let status indicator info = |
68 | match info with | |
69 | | "" -> indicator | |
70 | | _ -> sprintf "%s: %s" indicator info | |
71 | ||
9949f15b SK |
72 | let status_pass ?(info="") () = |
73 | status (color Green "Pass") info | |
39dd0869 | 74 | |
9949f15b SK |
75 | let status_fail ?(info="") () = |
76 | status (color Red "Fail") info | |
39dd0869 | 77 | |
9949f15b SK |
78 | let status_skip ?(info="") () = |
79 | status (color Yellow "Skip") info | |
39dd0869 | 80 | |
e69e4e8b SK |
81 | let case |
82 | ?(out_lexing) | |
83 | ?(out_parsing) | |
5da420a8 | 84 | ?(is_error_expected_semant=(fun _ -> false)) |
e69e4e8b SK |
85 | ~code |
86 | name | |
87 | = | |
d3bdde4b SK |
88 | { name |
89 | ; code | |
90 | ; out_lexing | |
91 | ; out_parsing | |
5da420a8 | 92 | ; is_error_expected_semant |
d3bdde4b SK |
93 | } |
94 | ||
95 | let bar_sep = String.make 80 '-' | |
96 | let bar_end = String.make 80 '=' | |
97 | ||
98 | let indent = | |
99 | let unit_spaces = 2 in | |
100 | fun n -> | |
101 | String.make (n * unit_spaces) ' ' | |
102 | ||
103 | let pass_lexing code : (Tiger_parser.token list, string) result = | |
104 | let lexbuf = Lexing.from_string code in | |
105 | let rec tokens () = | |
106 | let token = Tiger_lexer.token lexbuf in | |
107 | (* Avoiding fragile pattern-matching *) | |
108 | if token = Tiger_parser.EOF then [] else token :: tokens () | |
109 | in | |
110 | match tokens () with | |
111 | | exception e -> Error (Printexc.to_string e) | |
112 | | tokens -> Ok tokens | |
113 | ||
e69e4e8b | 114 | let pass_parsing code : (Tiger_absyn.t, string) result = |
d3bdde4b SK |
115 | let lb = Lexing.from_string code in |
116 | match Tiger_parser.program Tiger_lexer.token lb with | |
117 | | exception Parsing.Parse_error -> | |
118 | let module L = Lexing in | |
119 | let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in | |
120 | let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in | |
121 | Error msg | |
122 | | ast -> | |
123 | Ok ast | |
124 | ||
ea3f5e0c SK |
125 | let pass_semant (absyn_opt : Tiger_absyn.t option) : (unit, string) result = |
126 | match absyn_opt with | |
127 | | None -> | |
128 | Error "AST not provided" | |
129 | | Some absyn -> | |
130 | Ok (Tiger_semant.transProg absyn) | |
131 | ||
d3bdde4b SK |
132 | let s = sprintf |
133 | let p = printf | |
134 | let p_ln = print_newline | |
135 | let p_indent n = p "%s" (indent n) | |
136 | ||
137 | let run tests = | |
b762cacb | 138 | let failure_count = ref 0 in |
e69e4e8b SK |
139 | let run_pass ~f ~input ~expect_output ~is_error_expected = |
140 | let output_status = "n/a" in | |
141 | let output_value = None in | |
d3bdde4b SK |
142 | match f input with |
143 | | exception e -> | |
39dd0869 | 144 | let execution_status = |
e69e4e8b SK |
145 | (match e with |
146 | | Tiger_error.T e when is_error_expected e -> | |
9949f15b | 147 | status_pass () ~info:(Tiger_error.to_string e) |
e69e4e8b | 148 | | Tiger_error.T e -> |
b762cacb | 149 | incr failure_count; |
9949f15b | 150 | status_fail () ~info:(Tiger_error.to_string e) |
e69e4e8b | 151 | | e -> |
b762cacb | 152 | incr failure_count; |
9949f15b | 153 | status_fail () ~info:(Printexc.to_string e) |
e69e4e8b SK |
154 | ) |
155 | in | |
39dd0869 | 156 | ( execution_status |
e69e4e8b SK |
157 | , output_status |
158 | , output_value | |
d3bdde4b | 159 | ) |
39dd0869 | 160 | | Error info -> |
b762cacb | 161 | incr failure_count; |
9949f15b | 162 | ( status_fail ~info () |
e69e4e8b SK |
163 | , output_status |
164 | , output_value | |
d3bdde4b SK |
165 | ) |
166 | | Ok produced -> | |
9949f15b | 167 | let execution_status = status_pass () in |
e69e4e8b | 168 | let output_status = |
d3bdde4b | 169 | match |
e69e4e8b | 170 | Option.map expect_output (fun expected -> expected = produced) |
d3bdde4b SK |
171 | with |
172 | | None -> | |
9949f15b | 173 | status_skip () ~info:"expected output not provided" |
d3bdde4b | 174 | | Some true -> |
9949f15b | 175 | status_pass () |
d3bdde4b | 176 | | Some false -> |
b762cacb | 177 | incr failure_count; |
9949f15b | 178 | status_fail () |
d3bdde4b | 179 | in |
e69e4e8b SK |
180 | let output_value = Some produced in |
181 | (execution_status, output_status, output_value) | |
d3bdde4b | 182 | in |
0f031bf2 | 183 | let test_case_count = ref 0 in |
d3bdde4b | 184 | List.iter tests ~f:( |
5da420a8 SK |
185 | fun |
186 | { name | |
187 | ; code | |
188 | ; out_lexing | |
189 | ; out_parsing | |
190 | ; is_error_expected_semant | |
191 | } | |
192 | -> | |
0f031bf2 | 193 | incr test_case_count; |
e69e4e8b SK |
194 | let (stat_lex_exe, stat_lex_out_cmp, _) = |
195 | run_pass | |
196 | ~f:pass_lexing | |
197 | ~input:code | |
198 | ~expect_output:out_lexing | |
5da420a8 | 199 | ~is_error_expected:(fun _ -> false) |
e69e4e8b | 200 | in |
ea3f5e0c | 201 | let (stat_pars_exe, stat_pars_out_cmp, absyn_opt) = |
e69e4e8b SK |
202 | run_pass |
203 | ~f:pass_parsing | |
204 | ~input:code | |
205 | ~expect_output:out_parsing | |
5da420a8 | 206 | ~is_error_expected:(fun _ -> false) |
e69e4e8b | 207 | in |
ea3f5e0c SK |
208 | let (stat_semant_exe, stat_semant_out_cmp, _) = |
209 | run_pass | |
210 | ~f:pass_semant | |
211 | ~input:absyn_opt | |
212 | ~expect_output:(Some ()) | |
5da420a8 | 213 | ~is_error_expected:is_error_expected_semant |
ea3f5e0c | 214 | in |
d3bdde4b SK |
215 | p "%s" bar_sep; p_ln (); |
216 | p "Test: %S" name; p_ln (); | |
217 | p_indent 1; p "Lexing:"; p_ln (); | |
e69e4e8b SK |
218 | p_indent 2; p "exe: %s" stat_lex_exe ; p_ln (); |
219 | p_indent 2; p "out: %s" stat_lex_out_cmp; p_ln (); | |
d3bdde4b | 220 | p_indent 1; p "Parsing:"; p_ln (); |
e69e4e8b SK |
221 | p_indent 2; p "exe: %s" stat_pars_exe ; p_ln (); |
222 | p_indent 2; p "out: %s" stat_pars_out_cmp; p_ln (); | |
ea3f5e0c SK |
223 | p_indent 1; p "Semantic Analysis:"; p_ln (); |
224 | p_indent 2; p "exe: %s" stat_semant_exe ; p_ln (); | |
225 | p_indent 2; p "out: %s" stat_semant_out_cmp; p_ln (); | |
d3bdde4b SK |
226 | ); |
227 | p "%s" bar_end; p_ln (); | |
b762cacb | 228 | p "%s" |
0f031bf2 SK |
229 | ( let info = |
230 | s "%d failures in %d test cases" !failure_count !test_case_count | |
231 | in | |
232 | match !failure_count with | |
233 | | 0 -> status_pass () ~info | |
234 | | _ -> status_fail () ~info | |
b762cacb SK |
235 | ); |
236 | p_ln (); | |
d3bdde4b | 237 | p "%s" bar_end; p_ln (); |
b762cacb | 238 | exit !failure_count |