* out foo | OK | ... | ERROR
*
* *)
+(* TODO: Perhaps a global option whether to print non-fail info? *)
open Printf
; code : string
; out_lexing : (Tiger_parser.token list) option
; out_parsing : Tiger_absyn.t option
+ ; is_error_expected_parsing : (Tiger_error.t -> bool) option
; is_error_expected_semant : (Tiger_error.t -> bool) option
}
type color =
| Red
| Red_bold
- | Yellow
- | Green
| Green_bold
| Grey_bold
| Grey_bold -> "\027[1;30m"
| Red -> "\027[0;31m"
| Red_bold -> "\027[1;31m"
- | Yellow -> "\027[0;33m"
- | Green -> "\027[0;32m"
| Green_bold -> "\027[1;32m"
let color_off = "\027[0m"
let color_on = color_to_ansi_code color in
sprintf "%s%s%s" color_on string color_off
-let colorize str = function
+let color_opt str = function
| Some c -> (color_to_ansi_code c) ^ str ^ color_off
| None -> str
| Fail -> "X"
| Skip -> "-"
-let status indicator info =
- match info with
- | "" -> indicator
- | _ -> sprintf "%s: %s" indicator info
-
-(* TODO: Perhaps a global option whether to print non-fail info? *)
-let status_pass ?(info="") () =
- status (color Green "P") info
-
-let status_fail ?(info="") () =
- status (color Red "F") info
-
-let status_skip ?(info="") () =
- (*let indicator = (color Yellow "Skip") in*)
- let indicator = "S" in
- status indicator info
-
let case
?(out_lexing=None)
?(out_parsing=None)
+ ?(is_error_expected_parsing=None)
?(is_error_expected_semant=None)
~code
name
; code
; out_lexing
; out_parsing
+ ; is_error_expected_parsing
; is_error_expected_semant
}
let bar_horiz_major = color Grey_bold (String.make 80 '=')
let bar_vert = color Grey_bold "|"
-let indent =
- let unit_spaces = 2 in
- fun n ->
- String.make (n * unit_spaces) ' '
-
let lexbuf_set_filename lb filename
: unit
=
| ast ->
Ok ast
-let pass_semant (absyn_opt : Tiger_absyn.t option)
+let pass_semant (absyn : Tiger_absyn.t)
: (unit, string) result
=
- match absyn_opt with
- | None ->
- Error "AST not provided"
- | Some absyn ->
- Ok (Tiger_semant.transProg absyn)
+ Ok (Tiger_semant.transProg absyn)
let str_exact str exact =
let len = String.length str in
let take = if len > exact then exact else len in
- let str = String.sub str 0 take in
+ let str = String.sub str ~pos:0 ~len:take in
let pad = exact - take in
let pad = String.make pad ' ' in
str ^ pad
let s = sprintf
let p = printf
let p_ln = print_newline
-let p_indent n = p "%s" (indent n)
let run tests =
Printexc.record_backtrace true;
}
in
let test_case_count = ref 0 in
- let col_1_width = 25 in
- let col_i_width = 10 in
+ let col_1_width = 30 in
let p_stat width (exe, out) =
(* All this gymnastics to ignore color codes in cell width *)
let min = 5 in
let width = if width > min then width else min in
- p "%s" (String.concat "" (List.init ~len:width ~f:(function
+ p "%s" (String.concat ~sep:"" (List.init ~len:width ~f:(function
| 0 -> " "
| 1 -> bar_vert
| 2 -> " "
- | 3 -> colorize (status_to_str exe) (status_to_color exe)
- | 4 -> colorize (status_to_str out) (status_to_color out)
+ | 3 -> color_opt (status_to_str exe) (status_to_color exe)
+ | 4 -> color_opt (status_to_str out) (status_to_color out)
| _ -> " "
)))
; code
; out_lexing
; out_parsing
+ ; is_error_expected_parsing
; is_error_expected_semant
}
->
run_pass
~f:(fun () -> pass_parsing ~fake_filename:name ~code)
~expect_output:out_parsing
- ~is_error_expected:None
+ ~is_error_expected:is_error_expected_parsing
in
let res_sem =
- run_pass
- ~f:(fun () -> pass_semant res_pars.out_val)
- ~expect_output:(Some ())
- ~is_error_expected:is_error_expected_semant
+ (* TODO: Replace this hack with general test-dependency checking *)
+ match res_pars.out_val with
+ | None ->
+ { exe_stat = Skip
+ ; exe_msg = "No AST provided"
+ ; out_stat = Skip
+ ; out_val = None
+ ; out_msg = ""
+ }
+ | Some absyn ->
+ run_pass
+ ~f:(fun () -> pass_semant absyn)
+ ~expect_output:(Some ())
+ ~is_error_expected:is_error_expected_semant
in
let results =
(* Replacing out_val for type compatibility *)
);
);
p "%s" bar_horiz_major; p_ln ();
- p "%s"
- ( let info =
- s "%d failures in %d test cases" !count_fail_all !test_case_count
- in
- match !count_fail_all with
- | 0 -> status_pass () ~info
- | _ -> status_fail () ~info
- );
+ p "%s %d failures in %d test cases"
+ (match !count_fail_all with
+ | 0 -> color_opt (status_to_str Pass) (status_to_color Pass)
+ | _ -> color_opt (status_to_str Fail) (status_to_color Fail)
+ )
+ !count_fail_all
+ !test_case_count;
p_ln ();
p "%s" bar_horiz_major; p_ln ();
exit !count_fail_all