- let error_count = ref 0 in
- let run_pass ~f ~input ~expect_output ~is_error_expected =
- let output_status = "n/a" in
- let output_value = None in
- match f input with
- | exception e ->
- let status_text, error_text =
- (match e with
- | Tiger_error.T e when is_error_expected e ->
- ((color Green "OK"), Tiger_error.to_string e)
- | Tiger_error.T e ->
- incr error_count;
- ((color Red "ERROR"), Tiger_error.to_string e)
- | e ->
- incr error_count;
- ((color Red "ERROR"), Printexc.to_string e)
- )
- in
- ( s "%s: %s" status_text error_text
- , output_status
- , output_value
- )
- | Error msg ->
- incr error_count;
- ( s "%s: %s" (color Red "ERROR") msg
- , output_status
- , output_value
- )
- | Ok produced ->
- let execution_status = s "%s" (color Green "OK") in
- let output_status =
+ Printexc.record_backtrace true;
+ let fail, fail_count =
+ let count_fail_all = ref 0 in
+ ( (fun () -> incr count_fail_all; Fail)
+ , (fun () -> !count_fail_all)
+ )
+ in
+ let run_pass ~f ~expect_output ~is_error_expected =
+ let execution = match f () with exception e -> `Exn e | o -> `Out o in
+ (match execution, is_error_expected with
+ | `Exn (Err.T e), Some is_error_expected when is_error_expected e ->
+ { exe_stat = Pass
+ ; exe_msg = ""
+ ; out_stat = Skip
+ ; out_val = None
+ ; out_msg = ""
+ }
+ | `Exn e, Some _
+ | `Exn e, None ->
+ let b = Printexc.get_backtrace () in
+ let e = exn_to_string e in
+ { exe_stat = fail ()
+ ; exe_msg = s "\n\tException: %s.\n\tBacktrace: %s" e b
+ ; out_stat = Skip
+ ; out_val = None
+ ; out_msg = ""
+ }
+ | `Out output, Some _ ->
+ { exe_stat = fail ()
+ ; exe_msg = "Expected exception, but got output."
+ ; out_stat = fail ()
+ ; out_val = Some output (* TODO: Do we really want to keep going? *)
+ ; out_msg = "Expected exception, but got output."
+ }
+ | `Out output, None ->
+ let (out_stat, out_msg) =