Escape newline in strings
[tiger.ml.git] / compiler / src / lib / tiger / tiger_test.ml
CommitLineData
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
25open Printf
26
27module List = ListLabels
28module String = StringLabels
29
30module Option : sig
31 type 'a t = 'a option
32
33 val map : 'a t -> ('a -> 'b) -> 'b t
34end = 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)
41end
42
43type 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
51type color =
52 | Red
53 | Yellow
54 | Green
55
56
57let color_to_ansi_code = function
58 | Red -> "\027[0;31m"
59 | Yellow -> "\027[0;33m"
60 | Green -> "\027[0;32m"
61
62let 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
67let status indicator info =
68 match info with
69 | "" -> indicator
70 | _ -> sprintf "%s: %s" indicator info
71
9949f15b
SK
72let status_pass ?(info="") () =
73 status (color Green "Pass") info
39dd0869 74
9949f15b
SK
75let status_fail ?(info="") () =
76 status (color Red "Fail") info
39dd0869 77
9949f15b
SK
78let status_skip ?(info="") () =
79 status (color Yellow "Skip") info
39dd0869 80
e69e4e8b
SK
81let 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
95let bar_sep = String.make 80 '-'
96let bar_end = String.make 80 '='
97
98let indent =
99 let unit_spaces = 2 in
100 fun n ->
101 String.make (n * unit_spaces) ' '
102
103let 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 114let 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
125let 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
132let s = sprintf
133let p = printf
134let p_ln = print_newline
135let p_indent n = p "%s" (indent n)
136
137let 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
This page took 0.069746 seconds and 4 git commands to generate.