Building a Test Framework
- Step 01
A Single Assertion
The simplest possible test: check that a condition holds. If it fails, raise an exception with a message. This is the foundation everything else builds on.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))Step 02Collecting Tests
A test is a named function. We store tests in a mutable list so they can be registered declaratively with a simple helper. Each test is just a unit function that might raise.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))type test = {name : string;fn : unit -> unit;}let tests : test list ref = ref []let register name fn =tests := { name; fn } :: !testslet () = register "addition" (fun () ->assert_equal ~expected:4 ~actual:(2 + 2)"two plus two")let () = register "multiplication" (fun () ->assert_equal ~expected:6 ~actual:(2 * 3)"two times three")Step 03A Test Runner
The runner iterates through registered tests, catching exceptions to report pass or fail. It counts results and prints a summary at the end.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))type test = {name : string;fn : unit -> unit;}let tests : test list ref = ref []let register name fn =tests := { name; fn } :: !teststype result =| Pass| Fail of stringlet run_one test =try test.fn (); Passwith| Test_failure msg -> Fail msg| exn -> Fail (Printexc.to_string exn)let run_all () =let results =List.rev !tests|> List.map (fun t -> (t.name, run_one t))inlet passed =List.length(List.filter(fun (_, r) -> r = Pass) results)inlet total = List.length results inList.iter (fun (name, result) ->match result with| Pass ->Printf.printf " PASS %s\n" name| Fail msg ->Printf.printf " FAIL %s: %s\n" name msg) results;Printf.printf "\n%d/%d tests passed\n"passed total;if passed < total then exit 1Step 04Better Assertions
Real frameworks need more than integer equality. We add string comparison, boolean checks, and a generic raises assertion that checks an exception is thrown.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))let assert_string_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf"%s: expected %S, got %S"msg expected actual))let assert_true condition msg =if not condition thenraise (Test_failure msg)let assert_raises fn msg =try fn ();raise (Test_failure(msg ^ ": expected exception"))with| Test_failure _ as e -> raise e| _ -> ()type test = {name : string;fn : unit -> unit;}let tests : test list ref = ref []let register name fn =tests := { name; fn } :: !teststype result = Pass | Fail of stringlet run_one test =try test.fn (); Passwith| Test_failure msg -> Fail msg| exn -> Fail (Printexc.to_string exn)let run_all () =let results =List.rev !tests|> List.map (fun t -> (t.name, run_one t))inlet passed = List.length(List.filter(fun (_, r) -> r = Pass) results) inlet total = List.length results inList.iter (fun (name, result) ->match result with| Pass ->Printf.printf " PASS %s\n" name| Fail msg ->Printf.printf " FAIL %s: %s\n"name msg) results;Printf.printf "\n%d/%d tests passed\n"passed total;if passed < total then exit 1Step 05Test Suites
As projects grow, tests need organization. We add a suite concept that groups related tests under a name. Suites can be nested and run independently.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))let assert_string_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %S, got %S"msg expected actual))let assert_true condition msg =if not condition thenraise (Test_failure msg)let assert_raises fn msg =try fn ();raise (Test_failure(msg ^ ": expected exception"))with Test_failure _ as e -> raise e | _ -> ()type test = { name : string; fn : unit -> unit }type result = Pass | Fail of stringtype suite = {suite_name : string;mutable suite_tests : test list;}let suites : suite list ref = ref []let create_suite name =let s = { suite_name = name;suite_tests = [] } insuites := s :: !suites; slet add_test suite name fn =suite.suite_tests <-{ name; fn } :: suite.suite_testslet run_one test =try test.fn (); Passwith| Test_failure msg -> Fail msg| exn -> Fail (Printexc.to_string exn)let run_suite suite =Printf.printf "Suite: %s\n" suite.suite_name;let results =List.rev suite.suite_tests|> List.map (fun t ->(t.name, run_one t)) inlet passed = List.length(List.filter(fun (_, r) -> r = Pass) results) inlet total = List.length results inList.iter (fun (name, result) ->match result with| Pass ->Printf.printf " PASS %s\n" name| Fail msg ->Printf.printf " FAIL %s: %s\n"name msg) results;Printf.printf " %d/%d passed\n\n"passed total;passed = totallet run_all_suites () =let all_ok = List.for_all run_suite(List.rev !suites) inif not all_ok then exit 1Step 06Expect Tests
The crown jewel: expect tests capture actual output and compare it to an expected snapshot. On first run, they record the output. On later runs, they detect regressions. This is how tools like ppx_expect and Cram tests work.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))let assert_string_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %S, got %S"msg expected actual))let assert_true condition msg =if not condition thenraise (Test_failure msg)let assert_raises fn msg =try fn ();raise (Test_failure(msg ^ ": expected exception"))with Test_failure _ as e -> raise e | _ -> ()type test = { name : string; fn : unit -> unit }type result = Pass | Fail of stringtype suite = {suite_name : string;mutable suite_tests : test list;}let suites : suite list ref = ref []let create_suite name =let s = { suite_name = name;suite_tests = [] } insuites := s :: !suites; slet add_test suite name fn =suite.suite_tests <-{ name; fn } :: suite.suite_testslet run_one test =try test.fn (); Passwith| Test_failure msg -> Fail msg| exn -> Fail (Printexc.to_string exn)(* Expect test infrastructure *)let expect_dir = "_expect"let expect_test suite name fn =add_test suite name (fun () ->let buf = Buffer.create 256 infn (Buffer.add_string buf);let actual = Buffer.contents buf inlet path = Printf.sprintf "%s/%s/%s.expected"expect_dir suite.suite_name name inif Sys.file_exists path then beginlet ic = open_in path inlet expected = really_input_string ic(in_channel_length ic) inclose_in ic;assert_string_equal~expected ~actual(name ^ " snapshot")end else beginlet dir = Filename.dirname path inignore (Sys.command("mkdir -p " ^ dir));let oc = open_out path inoutput_string oc actual;close_out oc;Printf.printf" NEW %s (snapshot saved)\n" nameend)let run_suite suite =Printf.printf "Suite: %s\n" suite.suite_name;let results =List.rev suite.suite_tests|> List.map (fun t ->(t.name, run_one t)) inlet passed = List.length(List.filter(fun (_, r) -> r = Pass) results) inlet total = List.length results inList.iter (fun (name, result) ->match result with| Pass ->Printf.printf " PASS %s\n" name| Fail msg ->Printf.printf " FAIL %s: %s\n"name msg) results;Printf.printf " %d/%d passed\n\n"passed total;passed = totallet run_all_suites () =let all_ok = List.for_all run_suite(List.rev !suites) inif not all_ok then exit 1main.ml 1 / 6exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))Step 01A Single Assertion
The simplest possible test: check that a condition holds. If it fails, raise an exception with a message. This is the foundation everything else builds on.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))Step 02Collecting Tests
A test is a named function. We store tests in a mutable list so they can be registered declaratively with a simple helper. Each test is just a unit function that might raise.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))type test = {name : string;fn : unit -> unit;}let tests : test list ref = ref []let register name fn =tests := { name; fn } :: !testslet () = register "addition" (fun () ->assert_equal ~expected:4 ~actual:(2 + 2)"two plus two")let () = register "multiplication" (fun () ->assert_equal ~expected:6 ~actual:(2 * 3)"two times three")Step 03A Test Runner
The runner iterates through registered tests, catching exceptions to report pass or fail. It counts results and prints a summary at the end.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))type test = {name : string;fn : unit -> unit;}let tests : test list ref = ref []let register name fn =tests := { name; fn } :: !testslet () = register "addition" (fun () ->assert_equal ~expected:4 ~actual:(2 + 2)"two plus two")type result =| Pass| Fail of stringlet () = register "multiplication" (fun () ->assert_equal ~expected:6 ~actual:(2 * 3)"two times three")let run_one test =try test.fn (); Passwith| Test_failure msg -> Fail msg| exn -> Fail (Printexc.to_string exn)let run_all () =let results =List.rev !tests|> List.map (fun t -> (t.name, run_one t))inlet passed =List.length(List.filter(fun (_, r) -> r = Pass) results)inlet total = List.length results inList.iter (fun (name, result) ->match result with| Pass ->Printf.printf " PASS %s\n" name| Fail msg ->Printf.printf " FAIL %s: %s\n" name msg) results;Printf.printf "\n%d/%d tests passed\n"passed total;if passed < total then exit 1Step 04Better Assertions
Real frameworks need more than integer equality. We add string comparison, boolean checks, and a generic raises assertion that checks an exception is thrown.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))let assert_string_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf"%s: expected %S, got %S"msg expected actual))let assert_true condition msg =if not condition thenraise (Test_failure msg)let assert_raises fn msg =try fn ();raise (Test_failure(msg ^ ": expected exception"))with| Test_failure _ as e -> raise e| _ -> ()type test = {name : string;fn : unit -> unit;}let tests : test list ref = ref []let register name fn =tests := { name; fn } :: !teststype result =| Pass| Fail of stringtype result = Pass | Fail of stringlet run_one test =try test.fn (); Passwith| Test_failure msg -> Fail msg| exn -> Fail (Printexc.to_string exn)let run_all () =let results =List.rev !tests|> List.map (fun t -> (t.name, run_one t))inlet passed =List.length(List.filter(fun (_, r) -> r = Pass) results)inlet passed = List.length(List.filter(fun (_, r) -> r = Pass) results) inlet total = List.length results inList.iter (fun (name, result) ->match result with| Pass ->Printf.printf " PASS %s\n" name| Fail msg ->Printf.printf " FAIL %s: %s\n" name msgPrintf.printf " FAIL %s: %s\n"name msg) results;Printf.printf "\n%d/%d tests passed\n"passed total;if passed < total then exit 1Step 05Test Suites
As projects grow, tests need organization. We add a suite concept that groups related tests under a name. Suites can be nested and run independently.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))let assert_string_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf"%s: expected %S, got %S"(Printf.sprintf "%s: expected %S, got %S"msg expected actual))let assert_true condition msg =if not condition thenraise (Test_failure msg)let assert_raises fn msg =try fn ();raise (Test_failure(msg ^ ": expected exception"))with| Test_failure _ as e -> raise e| _ -> ()with Test_failure _ as e -> raise e | _ -> ()type test = {name : string;fn : unit -> unit;type test = { name : string; fn : unit -> unit }type result = Pass | Fail of stringtype suite = {suite_name : string;mutable suite_tests : test list;}let tests : test list ref = ref []let suites : suite list ref = ref []let register name fn =tests := { name; fn } :: !testslet create_suite name =let s = { suite_name = name;suite_tests = [] } insuites := s :: !suites; stype result = Pass | Fail of stringlet add_test suite name fn =suite.suite_tests <-{ name; fn } :: suite.suite_testslet run_one test =try test.fn (); Passwith| Test_failure msg -> Fail msg| exn -> Fail (Printexc.to_string exn)let run_all () =let run_suite suite =Printf.printf "Suite: %s\n" suite.suite_name;let results =List.rev !tests|> List.map (fun t -> (t.name, run_one t))inList.rev suite.suite_tests|> List.map (fun t ->(t.name, run_one t)) inlet passed = List.length(List.filter(fun (_, r) -> r = Pass) results) inlet total = List.length results inList.iter (fun (name, result) ->match result with| Pass ->Printf.printf " PASS %s\n" name| Fail msg ->Printf.printf " FAIL %s: %s\n"name msg) results;Printf.printf "\n%d/%d tests passed\n"Printf.printf " %d/%d passed\n\n"passed total;if passed < total then exit 1passed = totallet run_all_suites () =let all_ok = List.for_all run_suite(List.rev !suites) inif not all_ok then exit 1Step 06Expect Tests
The crown jewel: expect tests capture actual output and compare it to an expected snapshot. On first run, they record the output. On later runs, they detect regressions. This is how tools like ppx_expect and Cram tests work.
exception Test_failure of stringlet assert_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %s, got %s"msg(string_of_int expected)(string_of_int actual)))let assert_string_equal ~expected ~actual msg =if expected <> actual thenraise (Test_failure(Printf.sprintf "%s: expected %S, got %S"msg expected actual))let assert_true condition msg =if not condition thenraise (Test_failure msg)let assert_raises fn msg =try fn ();raise (Test_failure(msg ^ ": expected exception"))with Test_failure _ as e -> raise e | _ -> ()type test = { name : string; fn : unit -> unit }type result = Pass | Fail of stringtype suite = {suite_name : string;mutable suite_tests : test list;}let suites : suite list ref = ref []let create_suite name =let s = { suite_name = name;suite_tests = [] } insuites := s :: !suites; slet add_test suite name fn =suite.suite_tests <-{ name; fn } :: suite.suite_testslet run_one test =try test.fn (); Passwith| Test_failure msg -> Fail msg| exn -> Fail (Printexc.to_string exn)(* Expect test infrastructure *)let expect_dir = "_expect"let expect_test suite name fn =add_test suite name (fun () ->let buf = Buffer.create 256 infn (Buffer.add_string buf);let actual = Buffer.contents buf inlet path = Printf.sprintf "%s/%s/%s.expected"expect_dir suite.suite_name name inif Sys.file_exists path then beginlet ic = open_in path inlet expected = really_input_string ic(in_channel_length ic) inclose_in ic;assert_string_equal~expected ~actual(name ^ " snapshot")end else beginlet dir = Filename.dirname path inignore (Sys.command("mkdir -p " ^ dir));let oc = open_out path inoutput_string oc actual;close_out oc;Printf.printf" NEW %s (snapshot saved)\n" nameend)let run_suite suite =Printf.printf "Suite: %s\n" suite.suite_name;let results =List.rev suite.suite_tests|> List.map (fun t ->(t.name, run_one t)) inlet passed = List.length(List.filter(fun (_, r) -> r = Pass) results) inlet total = List.length results inList.iter (fun (name, result) ->match result with| Pass ->Printf.printf " PASS %s\n" name| Fail msg ->Printf.printf " FAIL %s: %s\n"name msg) results;Printf.printf " %d/%d passed\n\n"passed total;passed = totallet run_all_suites () =let all_ok = List.for_all run_suite(List.rev !suites) inif not all_ok then exit 1Playground