Merge pull request #329 from samoht/better-tests

Remove oUnit, use alcotest properly

Makefile

@@ -5,7 +5,7 @@ build:
 	jbuilder build @install --dev
 
 test:
-	jbuilder runtest
+	jbuilder runtest --dev
 
 install:
 	jbuilder install

tcpip.opam

@@ -36,17 +36,16 @@ depends: [
   "mirage-time-lwt" {>= "1.0.0"}
   "ipaddr" {>= "2.2.0"}
   "mirage-profile" {>= "0.5"}
-  "mirage-flow" {test & >= "1.2.0"}
-  "mirage-vnetif" {test & >= "0.4.0"}
-  "alcotest" {test & >="0.7.0"}
-  "ounit" {test}
-  "pcap-format" {test}
-  "mirage-clock-unix" {test & >= "1.2.0"}
   "fmt"
   "lwt" {>= "3.0.0"}
   "logs" {>= "0.6.0"}
   "duration"
   "io-page-unix"
   "randomconv"
+  "mirage-flow" {test & >= "1.2.0"}
+  "mirage-vnetif" {test & >= "0.4.0"}
+  "alcotest" {test & >="0.7.0"}
+  "pcap-format" {test}
+  "mirage-clock-unix" {test & >= "1.2.0"}
 ]
 available: [ocaml-version >= "4.03.0"]

test/common.ml

@@ -1,43 +1,24 @@
-let (>>=) = Lwt.(>>=)
+open Lwt.Infix
 
-let fail fmt = Printf.ksprintf OUnit.assert_failure fmt
+let failf fmt = Fmt.kstrf Alcotest.fail fmt
 
 let or_error name fn t =
   fn t >>= function
-  | Error _ -> fail "or_error starting %s" name
+  | Error _ -> failf "or_error starting %s" name
   | Ok t    -> Lwt.return t
 
 let expect_error error name fn t =
   fn t >>= function
   | Error error2 when error2 = error -> Lwt.return t
-  | _    -> fail "expected error on %s" name
+  | _  -> failf "expected error on %s" name
 
-let assert_string msg a b =
-  let cmp a b = String.compare a b = 0 in
-  OUnit.assert_equal ~msg ~printer:(fun x -> x) ~cmp a b
-
-let cstruct =
-  let module M = struct
-    type t = Cstruct.t
-    let pp = Cstruct.hexdump_pp
-    let equal = Cstruct.equal
-  end in
-  (module M : Alcotest.TESTABLE with type t = M.t)
-
-let ipv4_packet = (module Ipv4_packet : Alcotest.TESTABLE with type t = Ipv4_packet.t)
-let udp_packet = (module Udp_packet : Alcotest.TESTABLE with type t = Udp_packet.t)
-let tcp_packet = (module Tcp.Tcp_packet : Alcotest.TESTABLE with type t = Tcp.Tcp_packet.t)
+let ipv4_packet = Alcotest.testable Ipv4_packet.pp Ipv4_packet.equal
+let udp_packet = Alcotest.testable Udp_packet.pp Udp_packet.equal
+let tcp_packet = Alcotest.testable Tcp.Tcp_packet.pp Tcp.Tcp_packet.equal
+let cstruct = Alcotest.testable Cstruct.hexdump_pp Cstruct.equal
 
 let sequence =
-  let module M = struct
-    type t = Tcp.Sequence.t
-    let pp = Tcp.Sequence.pp
-    let equal x y = (=) 0 @@ Tcp.Sequence.compare x y
-  end in
-  (module M : Alcotest.TESTABLE with type t = M.t)
-
-let assert_bool msg a b =
-  OUnit.assert_equal ~msg ~printer:string_of_bool a b
+  let eq x y = Tcp.Sequence.compare x y = 0 in
+  Alcotest.testable Tcp.Sequence.pp eq
 
-let assert_int msg a b =
-  OUnit.assert_equal ~msg ~printer:string_of_int a b
+let options = Alcotest.testable Tcp.Options.pp Tcp.Options.equal

test/jbuild

@@ -2,7 +2,7 @@
 (executables
  ((names (test))
   (libraries (
-    alcotest oUnit lwt.unix io-page-unix tcpip.unix
+    alcotest lwt.unix io-page-unix tcpip.unix
     logs logs.fmt mirage-profile mirage-flow mirage-vnetif
     mirage-clock-unix pcap-format duration mirage-random
     rresult mirage-protocols-lwt mirage-stack-lwt
@@ -14,4 +14,4 @@
 (alias
  ((name    runtest)
   (deps    (test.exe))
-  (action (run ${<} -q -v))))
+  (action (run ${<} -q -e --color=always))))

test/test_connect.ml

@@ -32,16 +32,16 @@ module Test_connect (B : Vnetif_backends.Backend) = struct
   let test_string = "Hello world from Mirage 123456789...."
   let backend = V.create_backend ()
 
-  let err_read_eof () = fail "accept got EOF while reading"
-  let err_write_eof () = fail "client tried to write, got EOF"
+  let err_read_eof () = failf "accept got EOF while reading"
+  let err_write_eof () = failf "client tried to write, got EOF"
 
   let err_read e =
     let err = Format.asprintf "%a" V.Stackv4.TCPV4.pp_error e in
-    fail "Error while reading: %s" err
+    failf "Error while reading: %s" err
 
   let err_write e =
     let err = Format.asprintf "%a" V.Stackv4.TCPV4.pp_write_error e in
-    fail "client tried to write, got %s" err
+    failf "client tried to write, got %s" err
 
   let accept flow expected =
     let ip, port = V.Stackv4.TCPV4.dst flow in
@@ -52,15 +52,15 @@ module Test_connect (B : Vnetif_backends.Backend) = struct
     | Ok (`Data b) ->
       Lwt_unix.sleep 0.1 >>= fun () ->
       (* sleep first to capture data in pcap *)
-      assert_string "accept" expected (Cstruct.to_string b);
+      Alcotest.(check string) "accept" expected (Cstruct.to_string b);
       Logs.debug (fun f -> f "Connection closed");
       Lwt.return_unit
 
   let test_tcp_connect_two_stacks () =
     let timeout = 15.0 in
     Lwt.pick [
       (Lwt_unix.sleep timeout >>= fun () ->
-       fail "connect test timedout after %f seconds" timeout) ;
+       failf "connect test timedout after %f seconds" timeout) ;
 
       (V.create_stack backend server_ip netmask gw >>= fun s1 ->
        V.Stackv4.listen_tcpv4 s1 ~port:80 (fun f -> accept f test_string);

test/test_icmpv4.ml

@@ -1,3 +1,4 @@
+open Common
 open Result
 
 module Time = Vnetif_common.Time
@@ -43,8 +44,8 @@ let speaker_address = Ipaddr.V4.of_string_exn "192.168.222.10"
 let slowly fn =
   Time.sleep_ns (Duration.of_ms 100) >>= fun () -> fn >>= fun _ -> Time.sleep_ns (Duration.of_ms 100)
 
-let get_stack ?(backend = B.create ~use_async_readers:true 
-                  ~yield:(fun() -> Lwt_main.yield ()) ()) 
+let get_stack ?(backend = B.create ~use_async_readers:true
+                  ~yield:(fun() -> Lwt_main.yield ()) ())
                   ip =
   let network = Ipaddr.V4.Prefix.make 24 listener_address in
   let gateway = None in
@@ -104,7 +105,7 @@ let echo_request () =
       Alcotest.(check int) "icmp echo-reply code" 0x00 reply.code; (* should be code 0 *)
       Alcotest.(check int) "icmp echo-reply id" id_no id;
       Alcotest.(check int) "icmp echo-reply seq" seq_no seq;
-      Alcotest.(check Common.cstruct) "icmp echo-reply payload" payload request_payload;
+      Alcotest.(check cstruct) "icmp echo-reply payload" payload request_payload;
       Lwt.return_unit
   in
   Lwt.pick [

test/test_iperf.ml

@@ -59,20 +59,20 @@ module Test_iperf (B : Vnetif_backends.Backend) = struct
 
   let mlen = String.length msg
 
-  let err_eof () = fail "EOF while writing to TCP flow"
+  let err_eof () = failf "EOF while writing to TCP flow"
 
   let err_connect e ip port () =
     let err = Format.asprintf "%a" V.Stackv4.TCPV4.pp_error e in
     let ip  = Ipaddr.V4.to_string ip in
-    fail "Unable to connect to %s:%d: %s" ip port err
+    failf "Unable to connect to %s:%d: %s" ip port err
 
   let err_write e () =
     let err = Format.asprintf "%a" V.Stackv4.TCPV4.pp_write_error e in
-    fail "Error while writing to TCP flow: %s" err
+    failf "Error while writing to TCP flow: %s" err
 
   let err_read e () =
     let err = Format.asprintf "%a" V.Stackv4.TCPV4.pp_error e in
-    fail "Error in server while reading: %s" err
+    failf "Error in server while reading: %s" err
 
   let write_and_check flow buf =
     V.Stackv4.TCPV4.write flow buf >>= function
@@ -168,7 +168,7 @@ module Test_iperf (B : Vnetif_backends.Backend) = struct
 
     Lwt.pick [
       (Lwt_unix.sleep timeout >>= fun () -> (* timeout *)
-       fail "iperf test timed out after %f seconds" timeout);
+       failf "iperf test timed out after %f seconds" timeout);
 
       (server_ready >>= fun () ->
        Lwt_unix.sleep 0.1 >>= fun () -> (* Give server 0.1 s to call listen *)

test/test_ipv4.ml

@@ -1,4 +1,4 @@
-open OUnit
+open Common
 
 let test_unmarshal_with_options () =
   let datagram = Cstruct.create 40 in
@@ -7,8 +7,8 @@ let test_unmarshal_with_options () =
                             "\x00\xfa\x02\x00\x00\x00\x01\x03\x00\x00\x00\xe0\x00\x00\xfb") 0 datagram 0 40;
   match Ipv4_packet.Unmarshal.of_cstruct datagram with
   | Result.Ok ({Ipv4_packet.options ; _}, payload) ->
-      assert_equal (Cstruct.len options) 4;
-      assert_equal (Cstruct.len payload) 16;
+      Alcotest.(check int) "options" (Cstruct.len options) 4;
+      Alcotest.(check int) "payload" (Cstruct.len payload) 16;
       Lwt.return_unit
   | _ ->
       Alcotest.fail "Fail to parse ip packet with options"
@@ -21,8 +21,8 @@ let test_unmarshal_without_options () =
                             "\x00\x00\x00\x00\x50\x04\x00\x00\xec\x27\x00\x00") 0 datagram 0 40;
   match Ipv4_packet.Unmarshal.of_cstruct datagram with
   | Result.Ok ({Ipv4_packet.options ; _}, payload) ->
-      assert_equal (Cstruct.len options) 0;
-      assert_equal (Cstruct.len payload) 20;
+      Alcotest.(check int) "options" (Cstruct.len options) 0;
+      Alcotest.(check int) "payload" (Cstruct.len payload) 20;
       Lwt.return_unit
   | _ ->
       Alcotest.fail "Fail to parse ip packet with options"
@@ -43,7 +43,7 @@ let test_size () =
   let tmp = Ipv4_packet.Marshal.make_cstruct ~payload_len:(Cstruct.len payload) ip in
   let tmp = Cstruct.concat [tmp; payload] in
   Ipv4_packet.Unmarshal.of_cstruct tmp
-  |> Alcotest.(check (result (pair Common.ipv4_packet Common.cstruct) string)) "Loading an IP packet with IP options" (Ok (ip, payload));
+  |> Alcotest.(check (result (pair ipv4_packet cstruct) string)) "Loading an IP packet with IP options" (Ok (ip, payload));
   Lwt.return_unit
 
 let suite = [

test/test_ipv6.ml

@@ -1,3 +1,4 @@
+open Common
 module Time = Vnetif_common.Time
 module B = Vnetif_backends.Basic
 module V = Vnetif.Make(B)
@@ -54,7 +55,7 @@ let check_for_one_udp_packet netif ~src ~dst buf =
   Alcotest.(check ip) "receiver address" (Ipaddr.V6.of_string_exn "fc00::45") dst;
   (match Udp_packet.Unmarshal.of_cstruct buf with
   | Ok (_, payload) ->
-    Alcotest.(check Common.cstruct) "payload is correct" udp_message payload
+    Alcotest.(check cstruct) "payload is correct" udp_message payload
   | Error m -> Alcotest.fail m);
   (*after receiving 1 packet, disconnect stack so test can continue*)
   V.disconnect netif

test/test_rfc5961.ml

@@ -119,10 +119,9 @@ let run backend fsm sut () =
 
     (Lwt_mvar.take error_mbox >>= fun cause ->
      Lwt.return_some cause);
-  ] >>= function
-  | None -> Lwt.return_unit
-  | Some err ->
-    Alcotest.fail err;
+  ] >|= function
+  | None     -> ()
+  | Some err -> Alcotest.fail err
   ]