Improve the executable ./TestMidML.exe.

client/test/CheckML.ml

@@ -11,7 +11,7 @@ module LexUtil = MenhirLib.LexerUtil
 let print_type ty =
   PPrint.(ToChannel.pretty 0.9 80 stdout (FPrinter.print_type ty ^^ hardline))
 
-let translate ~rectypes e t =
+let translate ~verbose ~rectypes e t =
   try
     Some (Infer.translate ~rectypes e t)
   with
@@ -20,7 +20,7 @@ let translate ~rectypes e t =
         (LexUtil.range range) s;
       None
   | Infer.Cycle (range, ty) ->
-      if Config.verbose then begin
+     if verbose then begin
         Printf.eprintf "%!%sType error: cyclic type.\n"
           (LexUtil.range range);
         Printf.fprintf stdout "Type error: a cyclic type arose.\n";
@@ -28,7 +28,7 @@ let translate ~rectypes e t =
       end;
       None
   | Infer.Unify (range, ty1, ty2) ->
-      if Config.verbose then begin
+      if verbose then begin
         Printf.eprintf "%!%sType error: type mismatch.\n"
             (LexUtil.range range);
         Printf.fprintf stdout "Type error: mismatch between the type:\n";
@@ -108,6 +108,7 @@ let from_file filename =
 (* Running all passes over a single ML term. *)
 
 let test_with_args
+  ?(verbose=Config.verbose)
   ~rectypes
   ~(success:int ref) ~(total:int ref) (env : ML.datatype_env) (t : ML.term)
   : bool
@@ -122,7 +123,7 @@ let test_with_args
     ML2F.translate_env env in
   print_endline "Type inference and translation to System F...";
   let outcome =
-    translate ~rectypes env t
+    translate ~verbose ~rectypes env t
   in
   match outcome with
   | None ->
@@ -135,5 +136,5 @@ let test_with_args
       incr success;
       true
 
-let test env t =
-  test_with_args ~success:(ref 0) ~total:(ref 0) env t
+let test ?(verbose=Config.verbose) env t =
+  test_with_args ~verbose ~success:(ref 0) ~total:(ref 0) env t

client/test/TestMidML.ml

@@ -1,15 +1,17 @@
-open Test.CheckML
-
-let test_ok filename =
-  let (datatype_env, t) = from_file filename in
-  let _ = Test.CheckML.test ~rectypes:false datatype_env t in ()
+let test filename =
+  let (datatype_env, t) = Test.CheckML.from_file filename in
+  let _ = Test.CheckML.test ~verbose:true ~rectypes:false datatype_env t in ()
 
 let parse_args () =
-  let usage_msg = "todo" in
+  let usage_msg = "Typecheck midml programs." in
+  let test_dir = ref "" in
   let on_arg filename =
-    test_ok filename
+    test (Filename.concat !test_dir filename)
   in
-  Arg.parse [] on_arg usage_msg
+  let speclist = [
+      ("-I", Arg.Set_string test_dir, "Set a test directory")
+    ] in
+  Arg.parse speclist on_arg usage_msg
 
 let () =
   parse_args ()