More test cleanups

test/common.ml

@@ -1,33 +1,24 @@
-let (>>=) = Lwt.(>>=)
+open Lwt.Infix
 
-let fail fmt = Fmt.kstrf Alcotest.fail 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 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 eq x y = Tcp.Sequence.compare x y = 0 in
+  Alcotest.testable Tcp.Sequence.pp eq
+
+let options = Alcotest.testable Tcp.Options.pp Tcp.Options.equal

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
@@ -60,7 +60,7 @@ module Test_connect (B : Vnetif_backends.Backend) = struct
     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,3 +1,5 @@
+open Common
+
 let test_unmarshal_with_options () =
   let datagram = Cstruct.create 40 in
   Cstruct.blit_from_string ("\x46\xc0\x00\x28\x00\x00\x40\x00\x01\x02" ^
@@ -41,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
   ]
 
 

test/test_tcp_options.ml

@@ -1,8 +1,8 @@
-let options = Alcotest.testable Tcp.Options.pp Tcp.Options.equal
+open Common
 
 let check = Alcotest.(check @@ result (list options) string)
 
-  let errors ?(check_msg = false) exp = function
+let errors ?(check_msg = false) exp = function
   | Ok opt ->
     Fmt.kstrf Alcotest.fail "Result.Ok %a when Result.error %s expected"
       Tcp.Options.pps opt exp
@@ -206,14 +206,14 @@ let test_marshal_into_cstruct () =
     ~transport_packet:raw
   |> Alcotest.(check bool) "Checksum correct" true;
   Tcp.Tcp_packet.Unmarshal.of_cstruct raw
-  |> Alcotest.(check (result (pair Common.tcp_packet Common.cstruct) string))
+  |> Alcotest.(check (result (pair tcp_packet cstruct) string))
     "reload TCP packet" (Ok (packet, payload));
   let just_options = Cstruct.create options_size in
   let generated_options = Cstruct.shift buf Tcp.Tcp_wire.sizeof_tcp in
   Alcotest.(check int) "size of options buf" options_size @@
   Tcp.Options.marshal just_options options;
   (* expecting the result of Options.Marshal to be here *)
-  Alcotest.check Common.cstruct "marshalled options are as expected"
+  Alcotest.check cstruct "marshalled options are as expected"
     just_options generated_options;
   (* Now try with make_cstruct *)
   let headers =
@@ -263,7 +263,7 @@ let test_marshal_without_padding () =
     ~transport_packet:raw
   |> Alcotest.(check bool) "Checksum correct" true;
   Tcp.Tcp_packet.Unmarshal.of_cstruct raw
-  |> Alcotest.(check (result (pair Common.tcp_packet Common.cstruct) string))
+  |> Alcotest.(check (result (pair tcp_packet cstruct) string))
     "reload TCP packet" (Ok (packet, payload))
 
 let suite = [

test/test_udp.ml

@@ -1,3 +1,4 @@
+open Common
 open Result
 
 module Time = Vnetif_common.Time
@@ -50,7 +51,7 @@ let marshal_unmarshal () =
   match Udp_packet.Unmarshal.of_cstruct with_data with
   | Error s -> Alcotest.fail s
   | Ok (_header, data) ->
-    Alcotest.(check Common.cstruct) "unmarshalling gives expected data" payload data;
+    Alcotest.(check cstruct) "unmarshalling gives expected data" payload data;
     Lwt.return_unit
 
 let write () =
@@ -62,7 +63,7 @@ let write () =
 
 let unmarshal_regression () =
   let i = Cstruct.create 1016 in
-  Cstruct.memset i 30; 
+  Cstruct.memset i 30;
   Cstruct.set_char i 4 '\x04';
   Cstruct.set_char i 5 '\x00';
   Alcotest.(check (result reject pass)) "correctly return error for bad packet"
@@ -83,7 +84,7 @@ let marshal_marshal () =
   Udp_packet.Marshal.into_cstruct ~pseudoheader ~payload udp buffer
   |> Alcotest.(check (result unit string)) "Buffer big enough for header" (Ok ());
   Udp_packet.Unmarshal.of_cstruct (Cstruct.concat [buffer; payload])
-  |> Alcotest.(check (result (pair Common.udp_packet Common.cstruct) string)) "Save and reload" (Ok (udp, payload));
+  |> Alcotest.(check (result (pair udp_packet cstruct) string)) "Save and reload" (Ok (udp, payload));
   Lwt.return_unit
 
 let suite = [

test/vnetif_common.ml

@@ -15,8 +15,10 @@
  *)
 
 open Common
+open Lwt.Infix
 
-(* TODO Some of these modules and signatures could eventually be moved to mirage-vnetif *)
+(* TODO Some of these modules and signatures could eventually be moved
+   to mirage-vnetif *)
 
 module Time = struct
   type 'a io = 'a Lwt.t
@@ -85,7 +87,7 @@ module VNETIF_STACK ( B : Vnetif_backends.Backend) : (VNETIF_STACK with type bac
 
   let create_backend_listener backend listenf =
     match (B.register backend) with
-    | `Error _ -> fail "Error occured while registering to backend"
+    | `Error _ -> failf "Error occured while registering to backend"
     | `Ok id -> (B.set_listen_fn backend id listenf); id
 
   let disable_backend_listener backend id =