95 lines
2.5 KiB
OCaml
95 lines
2.5 KiB
OCaml
type case = string * (unit -> unit)
|
|
|
|
let failures = ref 0
|
|
|
|
let cases = ref 0
|
|
|
|
let check name condition =
|
|
incr cases;
|
|
if condition then Printf.printf "ok %s\n" name
|
|
else (
|
|
incr failures;
|
|
Printf.printf "FAIL %s\n" name)
|
|
|
|
let fail name message =
|
|
incr cases;
|
|
incr failures;
|
|
Printf.printf "FAIL %s: %s\n" name message
|
|
|
|
let check_equal_int name expected actual =
|
|
incr cases;
|
|
if expected = actual then Printf.printf "ok %s\n" name
|
|
else (
|
|
incr failures;
|
|
Printf.printf "FAIL %s: expected %d, got %d\n" name expected actual)
|
|
|
|
let check_equal_string name expected actual =
|
|
incr cases;
|
|
if expected = actual then Printf.printf "ok %s\n" name
|
|
else (
|
|
incr failures;
|
|
Printf.printf "FAIL %s: expected %S, got %S\n" name expected actual)
|
|
|
|
let check_true name message condition =
|
|
if condition then (incr cases; Printf.printf "ok %s\n" name)
|
|
else fail name message
|
|
|
|
let expect_diagnostic name thunk =
|
|
incr cases;
|
|
try
|
|
thunk ();
|
|
incr failures;
|
|
Printf.printf "FAIL %s: expected a diagnostic error\n" name
|
|
with
|
|
| Diagnostic.Error diagnostic ->
|
|
if diagnostic.Diagnostic.message = "" then (
|
|
incr failures;
|
|
Printf.printf "FAIL %s: empty diagnostic message\n" name)
|
|
else Printf.printf "ok %s\n" name
|
|
| error ->
|
|
incr failures;
|
|
Printf.printf "FAIL %s: unexpected exception %s\n" name (Printexc.to_string error)
|
|
|
|
let run_case (name, thunk) =
|
|
try thunk () with
|
|
| exception_ ->
|
|
incr failures;
|
|
Printf.printf "FAIL %s: raised %s\n" name (Printexc.to_string exception_)
|
|
|
|
let run_suite suite cases =
|
|
print_endline ("--- " ^ suite ^ " ---");
|
|
List.iter run_case cases
|
|
|
|
let failure_count () = !failures
|
|
|
|
let case_count () = !cases
|
|
|
|
let root () = try Sys.getenv "DELTA_ROOT" with Not_found -> "."
|
|
|
|
let fixture name = Filename.concat (root ()) (Filename.concat "test/fixture" name)
|
|
|
|
let read_fixture name = Native.read_file (fixture name)
|
|
|
|
let error_of thunk =
|
|
try
|
|
ignore (thunk ());
|
|
None
|
|
with Diagnostic.Error diagnostic -> Some diagnostic
|
|
|
|
let parse text = Parse.program text
|
|
|
|
let resolve text = Resolve.program (parse text)
|
|
|
|
let infer text = Infer.program (resolve text)
|
|
|
|
let parse_error text = error_of (fun () -> parse text)
|
|
|
|
let resolve_error text = error_of (fun () -> resolve text)
|
|
|
|
let infer_error text = error_of (fun () -> infer text)
|
|
|
|
let check_message name expected thunk =
|
|
match error_of thunk with
|
|
| None -> fail name "expected a diagnostic"
|
|
| Some diagnostic -> check_equal_string name expected diagnostic.Diagnostic.message
|