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
5 * code |> pass_a_exe |> pass_a_out |> ... |> pass_z_exe |> pass_z_out
18 * name | pass a | ... | pass z
19 * ---------+--------+-----+--------
20 * exe foo | OK | ... | OK
21 * out foo | OK | ... | ERROR
27 module List = ListLabels
28 module String = StringLabels
33 val map : 'a t -> ('a -> 'b) -> 'b t
40 | Some x -> Some (f x)
46 ; out_lexing : (Tiger_parser.token list) option
47 ; out_parsing : Tiger_absyn.t option
48 ; is_error_expected : (Tiger_error.t -> bool)
57 let color_to_ansi_code = function
59 | Yellow -> "\027[0;33m"
60 | Green -> "\027[0;32m"
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
70 ?(is_error_expected=(fun _ -> false))
81 let bar_sep = String.make 80 '-'
82 let bar_end = String.make 80 '='
85 let unit_spaces = 2 in
87 String.make (n * unit_spaces) ' '
89 let pass_lexing code : (Tiger_parser.token list, string) result =
90 let lexbuf = Lexing.from_string code in
92 let token = Tiger_lexer.token lexbuf in
93 (* Avoiding fragile pattern-matching *)
94 if token = Tiger_parser.EOF then [] else token :: tokens ()
97 | exception e -> Error (Printexc.to_string e)
100 let pass_parsing code : (Tiger_absyn.t, string) result =
101 let lb = Lexing.from_string code in
102 match Tiger_parser.program Tiger_lexer.token lb with
103 | exception Parsing.Parse_error ->
104 let module L = Lexing in
105 let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in
106 let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in
113 let p_ln = print_newline
114 let p_indent n = p "%s" (indent n)
117 let error_count = ref 0 in
118 let run_pass ~f ~input ~expect_output ~is_error_expected =
119 let output_status = "n/a" in
120 let output_value = None in
125 | Tiger_error.T e when is_error_expected e ->
126 (Green, Tiger_error.to_string e)
129 (Red, Tiger_error.to_string e)
132 (Red, Printexc.to_string e)
135 ( s "%s: %s" (color c "ERROR") e
141 ( s "%s: %s" (color Red "ERROR") msg
146 let execution_status = s "%s" (color Green "OK") in
149 Option.map expect_output (fun expected -> expected = produced)
152 s "%s" (color Yellow "expected output not provided")
154 s "%s" (color Green "OK")
157 s "%s" (color Red "ERROR")
159 let output_value = Some produced in
160 (execution_status, output_status, output_value)
163 fun {name; code; out_lexing; out_parsing; is_error_expected} ->
164 let (stat_lex_exe, stat_lex_out_cmp, _) =
168 ~expect_output:out_lexing
171 let (stat_pars_exe, stat_pars_out_cmp, _) =
175 ~expect_output:out_parsing
178 p "%s" bar_sep; p_ln ();
179 p "Test: %S" name; p_ln ();
180 p_indent 1; p "Lexing:"; p_ln ();
181 p_indent 2; p "exe: %s" stat_lex_exe ; p_ln ();
182 p_indent 2; p "out: %s" stat_lex_out_cmp; p_ln ();
183 p_indent 1; p "Parsing:"; p_ln ();
184 p_indent 2; p "exe: %s" stat_pars_exe ; p_ln ();
185 p_indent 2; p "out: %s" stat_pars_out_cmp; p_ln ();
187 p "%s" bar_end; p_ln ();
188 let failures = !error_count in
189 let clr = (if failures = 0 then Green else Red) in
190 p "Failures: %s" (color clr (string_of_int failures)); p_ln ();
191 p "%s" bar_end; p_ln ();