seppo/test/assert.ml

(*
   Utility methods built so I can get verifications in a
   'Expected %s but result %s' format. These are heavily based off of Java's
   JUnit library, specifically the Assert class.
   @author: Ben Jenkins
*)

(* Useful toggle for debugging if tests aren't working as expected. *)
let print_true_conditions : bool = false
let red_text_code : string = "\027[31m"

let string_of_list (string_of_a : 'a -> string) (lst : 'a list) : string =
  let str_lst = List.map string_of_a lst in
  "[" ^ String.concat "; " str_lst ^ "]"

let assert_strings (condition : bool) (test_name : string) (expected : string)
    (result : string) : 'a =
  (* Turns text red in linux terminal. *)
  if not condition then (
    Printf.fprintf stdout
      "%sTest '%s' failed. Expected: '%s', but actual: '%s'\n" red_text_code
      test_name expected result;
    assert condition)
  else if print_true_conditions then (
    Printf.fprintf stdout "Test '%s' passed. Value: '%s'\n" test_name expected;
    assert condition)

let assert_cmp (test_name : string) (cmp : 'a -> 'a -> bool)
    (string_of_a : 'a -> string) (expected : 'a) (result : 'a) : 'b =
  let condition = cmp expected result in
  let expected_display = string_of_a expected in
  let result_display = string_of_a result in
  assert_strings condition test_name expected_display result_display

(* Asserts that two objects are equal. *)
let assert_equals (test_name : string) (string_of_a : 'a -> string)
    (expected : 'a) (result : 'a) : 'b =
  assert_cmp test_name ( = ) string_of_a expected result

let assert_equals_int (test_name : string) (expected : int) (result : int) : 'a
  =
  assert_equals test_name string_of_int expected result

let assert_equals_int_list (test_name : string) (expected : int list)
    (result : int list) : 'a =
  assert_equals test_name (string_of_list string_of_int) expected result

let assert_equals_char (test_name : string) (expected : char) (result : char) :
  'a =
  let string_of_char my_char = String.make 1 my_char in
  assert_equals test_name string_of_char expected result

let assert_equals_char_list (test_name : string) (expected : char list)
    (result : char list) : 'a =
  let string_of_char my_char = String.make 1 my_char in
  assert_equals test_name (string_of_list string_of_char) expected result

let assert_equals_bool (test_name : string) (expected : bool) (result : bool) :
  'a =
  assert_equals test_name string_of_bool expected result

let assert_equals_bool_list (test_name : string) (expected : bool list)
    (result : bool list) : 'a =
  assert_equals test_name (string_of_list string_of_bool) expected result

let assert_equals_string (test_name : string) (expected : string)
    (result : string) : 'a =
  assert_strings (expected = result) test_name expected result

let assert_equals_string_list (test_name : string) (expected : string list)
    (result : string list) : 'a =
  assert_equals test_name (string_of_list (fun x -> x)) expected result

let assert_equals_float (test_name : string) (expected : float) (result : float)
    (epsilon : float) : 'a =
  let condition = abs_float (expected -. result) < epsilon in
  let expected_display = string_of_float expected in
  let result_display = string_of_float result in
  assert_strings condition test_name expected_display result_display

(* Asserts that two objects refer to the same object. *)
let assert_same (test_name : string) (string_of_a : 'a -> string)
    (expected : 'a) (result : 'a) : 'b =
  assert_cmp test_name ( == ) string_of_a expected result

let assert_same_int (test_name : string) (expected : int) (result : int) : 'a =
  assert_same test_name string_of_int expected result

let assert_same_float (test_name : string) (expected : float) (result : float) :
  'a =
  assert_same test_name string_of_float expected result

let assert_same_char (test_name : string) (expected : char) (result : char) : 'a
  =
  let string_of_char my_char = String.make 1 my_char in
  assert_same test_name string_of_char expected result

let assert_same_bool (test_name : string) (expected : bool) (result : bool) : 'a
  =
  assert_same test_name string_of_bool expected result

let assert_same_string (test_name : string) (expected : string)
    (result : string) : 'a =
  assert_strings (expected == result) test_name expected result

(* Asserts that a condition is true. *)
let assert_true (test_name : string) (result : bool) : 'a =
  assert_equals_bool test_name true result

(* Asserts that a condition is false. *)
let assert_false (test_name : string) (result : bool) : 'a =
  assert_equals_bool test_name false result

(* Fails a test with the given message. *)
let fail (test_name : string) (message : string) : 'a =
  Printf.fprintf stdout "%sTest '%s' failed. '%s'\n" red_text_code test_name
    message

let assert_none (test_name : string) (opt : float option) : 'a =
  match opt with
  | Some _x ->
    Printf.fprintf stdout
      "%sTest '%s' failed. Expected: 'None', but actual: 'Some'\n"
      red_text_code test_name;
    assert false
  | None ->
    if print_true_conditions then
      Printf.fprintf stdout "Test '%s' passed. Value: 'None'\n" test_name;
    assert true