[ocaml] CS2104 Lab3 test helper

main.ml

(*
Instructions:
 - copy test_parse_eval.ml into the same directory as lab3.ml (Right-click the
   <> to the right of the filename, Save as)
 - include the let expression below; feel free to replace the body with your
   own tests
*)
let module T = Test_parse_eval.Tester (Calc) (struct let reader = Parser.reader expr2 end) in
let test = T.test in
  print_endline "\n= examples =";
   
  (* the wrap option allows you to wrap ie. "(" ")" the expression quickly at an
  arbitrary depth; think of it as a fuzzer, albeit simple one. *)
  test ~wrap:(Some 5) "1+2" "(1+2)";
  test ~wrap:(Some 3) "1*2" "(1*2)";
  test ~wrap:(Some 1) "1/2" "(1/2)";
   
  (* use eval to specify the value to match against *)
  test ~eval:(Some (-1)) "1+~2" "(1+(0-2))";
   
  (* both *)
  test ~wrap:(Some 3) ~eval:(Some (-1)) "1+~2" "(1+(0-2))";

test_parse_eval.ml

module type T = sig
  val test : ?eval:int option -> ?wrap:int option -> string -> string -> unit
end

module Tester
  (Calc : sig
    type exp
    val string_of_exp: exp -> string
    val eval: exp -> Num.num
  end)
  (Parser : sig
    val reader: string -> Calc.exp
  end) : T = struct
    type parse_result = Failed of exn | Success of Calc.exp
    type 'a test_context = { trans:Calc.exp->'a; pr:'a->string }
    type 'a test_case = { context:'a test_context; s:string; expected:'a }
    type subject_body = string * string

    let test_one ({context=ctxt} as case:'a test_case) : bool * string =
      let parse (s:string) : parse_result =
        try
          let e = Parser.reader s in
            Success e
        with e -> Failed e in
      match parse case.s with
      | Failed(e) -> false, "encountered "^(Printexc.to_string e)
      | Success(expr) ->
        let actual = ctxt.trans expr in
          if case.expected = actual
          then true, (ctxt.pr actual)
          else false, (ctxt.pr actual)^" != "^(ctxt.pr case.expected)

    let test ?(eval:int option = None) ?(wrap:int option = None) (s:string) (expected_repr:string) : unit =
      let identity = (fun x -> x) in

      let repr_ctxt = { trans=Calc.string_of_exp; pr=identity; } and
          eval_ctxt = { trans=Calc.eval;     pr=Num.string_of_num; } in

      let test_repr : subject_body option * subject_body list =
        let (passed, reason) as result = test_one { context=repr_ctxt; s=s; expected=expected_repr } in
        if passed
        then Some(s, "=parse=> "^reason), []
        else None, [s, "=parse=> "^reason] in

      let merge_repr_wrap (passes, fails) s : subject_body option * subject_body list =
        let (passed, reason) as result = test_one { context=repr_ctxt; s=s; expected=expected_repr } in
        let pair = (s, "=parse=> "^reason) in
        if passed
        then
          let passes =
            match passes with
            | Some(subject, body) -> Some(subject^", (.)", body)
            | None -> Some(pair) in
            passes, fails
        else
          passes, pair::fails in

      let merge_eval (passes, fails) expected_eval : subject_body option * subject_body list =
        let (passed, reason) as result = test_one { context=eval_ctxt; s=s; expected=expected_eval } in
        let pair = (s, "=eval=> "^reason) in
        if passed
        then
          let passes =
            match passes with
            | Some(subject, body) -> Some(subject, body^", "^(snd pair))
            | None -> Some(pair) in
            passes, fails
        else
          passes, pair::fails in

      let emit passed (subject, body) =
        let header = if passed then "ok: " else "FAIL: " in
        let body = subject^" "^body in
        print_endline (header^body) in

      let passes, fails =
        let result =
          let result = test_repr in
            match wrap with
            | None -> result
            | Some(depth) ->
              let rec aux depth s result =
                if depth = 0
                then result
                else
                  let s = "("^s^")" in
                    aux (depth - 1) s (merge_repr_wrap result s) in
                aux depth s result in
          match eval with
          | Some(expected_int) -> merge_eval result (Num.num_of_int expected_int)
          | None -> result in
        (match passes with | Some(pair) -> emit true pair | None -> ());
        let rec aux xs =
          match xs with
          | [] -> ()
          | pair::xs -> emit false pair; aux xs in
          aux fails
  end