109 lines
2.9 KiB
OCaml
109 lines
2.9 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
|
|
|
|
type rng = { mutable state : int }
|
|
|
|
let rng seed = { state = seed land 0x3FFFFFFF }
|
|
|
|
let next rng =
|
|
rng.state <- (rng.state * 1103515245 + 12345) land 0x3FFFFFFF;
|
|
rng.state
|
|
|
|
let range rng bound = if bound <= 0 then 0 else next rng mod bound
|
|
|
|
let pick rng items = List.nth items (range rng (List.length items))
|
|
|
|
let string_of_int_list items = Util.join "," (List.map string_of_int items)
|