- fun {name; code; out_lexing; out_parsing} ->
- let ( lexing_exe, lexing_out) = run_pass pass_lexing code out_lexing in
- let (parsing_exe, parsing_out) = run_pass pass_parsing code out_parsing in
- p "%s" bar_sep; p_ln ();
- p "Test: %S" name; p_ln ();
- p_indent 1; p "Lexing:"; p_ln ();
- p_indent 2; p "exe: %s" lexing_exe; p_ln ();
- p_indent 2; p "out: %s" lexing_out; p_ln ();
- p_indent 1; p "Parsing:"; p_ln ();
- p_indent 2; p "exe: %s" parsing_exe; p_ln ();
- p_indent 2; p "out: %s" parsing_out; p_ln ();
+ fun
+ { name
+ ; code
+ ; out_lexing
+ ; out_parsing
+ ; is_error_expected_semant
+ }
+ ->
+ incr test_case_count;
+ let res_lex =
+ run_pass
+ ~f:(fun () -> pass_lexing ~fake_filename:name ~code)
+ ~expect_output:out_lexing
+ ~is_error_expected:None
+ in
+ let res_pars =
+ run_pass
+ ~f:(fun () -> pass_parsing ~fake_filename:name ~code)
+ ~expect_output:out_parsing
+ ~is_error_expected:None
+ in
+ let res_sem =
+ run_pass
+ ~f:(fun () -> pass_semant res_pars.out_val)
+ ~expect_output:(Some ())
+ ~is_error_expected:is_error_expected_semant
+ in
+ let results =
+ (* Replacing out_val for type compatibility *)
+ [ "Lexing" , {res_lex with out_val = None}
+ ; "Parsing" , {res_pars with out_val = None}
+ ; "Semant" , {res_sem with out_val = None}
+ ]
+ in
+ if !test_case_count > 1 then (p "%s" bar_horiz_minor; p_ln ());
+ p "%s" (str_exact name col_1_width);
+ List.iter results ~f:(fun (stage, {exe_stat=e; out_stat=o; _}) ->
+ p_stat ((String.length stage) + 3) (e, o)
+ );
+ p_ln ();
+ let printed_error = ref false in
+ List.iter results ~f:(
+ fun (stage, {exe_stat; exe_msg; out_stat; out_msg; _}) ->
+ (match exe_stat with
+ | Pass -> ()
+ | Skip -> ()
+ | Fail ->
+ printed_error := true;
+ p "%s: %s" (color Grey_bold stage) (color Red exe_msg);
+ p_ln ()
+ );
+ (match out_stat with
+ | Pass -> ()
+ | Skip -> ()
+ | Fail ->
+ printed_error := true;
+ p "%s: %s" (color Grey_bold stage) (color Red out_msg)
+ );
+ );