unikernel/duniverse/ocaml-uri/lib_test/test_runner_sexp.ml

@@ -0,0 +1,63 @@
+(*
+ * Copyright (c) 2012-2014 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2012-2014 David Sheets <sheets@alum.mit.edu>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)
+
+open OUnit
+open Printf
+
+let test_sexping =
+  let tests = [
+    "1", "https://example.com/foo?bar=1#frag",
+      "((scheme(https))(host(example.com))(path /foo)(query((bar(1))))(fragment(frag)))";
+    "2", "", "()";
+    "3", "/?foo=bar", "((path /)(query((foo(bar)))))";
+  ] in
+  let test uri exp =
+    let uri = Uri.of_string uri in
+    let s = Sexplib0.Sexp.to_string (Uri_sexp.sexp_of_t uri) in
+    let msg = sprintf "%s <> %s" s exp in
+    assert_equal ~msg s exp
+  in
+  List.map (fun (id,uri,exp) ->
+    ("test_sexping_"^id) >:: (fun () -> test uri exp)
+  ) tests
+
+(* Returns true if the result list contains successes only.
+   Copied from oUnit source as it isnt exposed by the mli *)
+let rec was_successful =
+  function
+    | [] -> true
+    | RSuccess _::t
+    | RSkip _::t ->
+        was_successful t
+    | RFailure _::_
+    | RError _::_
+    | RTodo _::_ ->
+        false
+
+let _ =
+  let suite = "URI-SEXP" >::: (
+    test_sexping
+  ) in
+  let verbose = ref false in
+  let set_verbose _ = verbose := true in
+  Arg.parse
+    [("-verbose", Arg.Unit set_verbose, "Run the test in verbose mode.");]
+    (fun x -> raise (Arg.Bad ("Bad argument : " ^ x)))
+    ("Usage: " ^ Sys.argv.(0) ^ " [-verbose]");
+  if not (was_successful (run_test_tt ~verbose:!verbose suite)) then
+  exit 1