Addding dynamic location format

Makefile

@@ -15,6 +15,7 @@ clean:
 	@jbuilder clean
 
 test:
+	@#NOCOLORS=1 jbuilder runtest
 	@jbuilder runtest
 
 

src/bin/serializer.ml

@@ -84,7 +84,7 @@ let boot_generic ~context ~runner ~mods:activated_mods oc suites : unit =
   let runner = String.capitalize_ascii runner in
   fprintf oc "let () = \n";
   fprintf oc "  let module T = %s in\n" runner;
-  fprintf oc "  T.run ~suites:[\n";
+  fprintf oc "  T.run [\n";
   List.iter
     ( fun suite ->
       fprintf oc

src/lib/extension_api.ml

@@ -47,11 +47,11 @@
       -> ctx: suite_ctx
       -> name: string
       -> f: callback
-      -> loc: (unit -> string)
+      -> loc: string
       -> test
 
     val run:
-      suites: suite list
+      suite list
       -> unit
 
 

src/lib/internal_runner.ml

@@ -0,0 +1,103 @@
+(* Monad type placeholder *)
+type 'a m = 'a
+
+(* Placeholder for the one parameter all test functions should have *)
+type arg = unit
+
+(* Signature for test functions in this test framework *)
+type callback =
+  | Fun       : (arg -> unit)                 -> callback
+  | Opt       : (arg -> 'a option)            -> callback
+  | Res       : (arg -> ('ok, 'err) result)   -> callback
+  | Async_fun : (arg -> unit m)               -> callback
+  | Async_opt : (arg -> 'a option m)          -> callback
+  | Async_res : (arg -> ('ok, 'err) result m) -> callback
+
+(* Internals of a test *)
+type test =
+  { test_name     : string
+  ; test_loc      : string
+  ; test_fqdn     : string
+  ; test_callback : callback
+  ; test_long     : bool
+  }
+
+type suite_ctx =
+  { ctx_name  : string
+  ; ctx_title : string
+  ; ctx_path  : string
+  }
+
+(* Internals of a test suite *)
+type suite =
+  { suite_name  : string
+  ; suite_path  : string
+  ; tests : test list
+  ; mutable has_errors : bool
+  }
+
+(* Creating a new test *)
+let test ~loc ~fqdn
+    ~(f:callback) test_name
+    : test
+  =
+  { test_name
+  ; test_loc = loc
+  ; test_fqdn = fqdn
+  ; test_callback = f
+  ; test_long = false
+  }
+
+let suite ~tests ~path suite_name : suite =
+  { suite_name
+  ; suite_path = path
+  ; tests = tests
+  ; has_errors = false
+  }
+
+let suite_ctx ~name ~title ~path =
+  { ctx_name  = name
+  ; ctx_title = title
+  ; ctx_path  = path
+  }
+
+(* XXX:
+  This is the Api used to wrap test functions with the matching modifiers.
+  By default, all modifiers should be inactive.
+*)
+
+let wrap_fun f : callback = Fun f
+let wrap_opt f : callback = Opt f
+let wrap_res f : callback = Res f
+
+let wrap_async_fun f : callback = Async_fun f
+let wrap_async_opt f : callback = Async_opt f
+let wrap_async_res f : callback = Async_res f
+
+
+
+let suite ~ctx:info ~(tests:test list) : suite =
+  { suite_name = info.ctx_title
+  ; suite_path = info.ctx_path
+  ; tests
+  ; has_errors = false
+  }
+
+let test
+    test_desc
+    ~ctx
+    ~name:test_name
+    ~f
+    ~loc
+    : test
+  =
+  let _ : suite_ctx = ctx in
+  { test_name     = test_desc
+  ; test_long     = true
+  ; test_callback = f
+  ; test_loc      = loc
+  ; test_fqdn     = (Printf.sprintf "%s.%s" ctx.ctx_name test_name)
+  }
+
+let run (suites: suite list) =
+  failwith "DRYUNIT FRAMEWORK IS NOT READY TO RUN"

src/lib/location.ml

@@ -0,0 +1,29 @@
+
+let next_int ~pos ~buf s : int =
+  let is_digit c =
+    ( match c with
+      | '0' .. '9' -> true
+      | _ -> false
+    ) in
+  while not (is_digit s.[!pos]) do
+    incr pos;
+  done;
+  Buffer.clear buf;
+  while is_digit s.[!pos] do
+    Buffer.add_char buf s.[!pos];
+    incr pos;
+  done;
+  int_of_string (Buffer.contents buf)
+
+
+let parse_loc loc =
+  let buf, pos = Buffer.create 3, ref 1 in
+  let next () = next_int ~pos ~buf loc in
+  let line = next () in
+  let start =
+    let _ = next () in
+    next () in
+  let length =
+    let _ = next (), next () in
+    next () - start in
+  line, start, length