diff --git a/test/common.ml b/test/common.ml index ffe6ea6ac..a34084791 100644 --- a/test/common.ml +++ b/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 diff --git a/test/test_connect.ml b/test/test_connect.ml index d549dbd46..46ad73b41 100644 --- a/test/test_connect.ml +++ b/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); diff --git a/test/test_icmpv4.ml b/test/test_icmpv4.ml index 0ab1505db..a50f10740 100644 --- a/test/test_icmpv4.ml +++ b/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 [ diff --git a/test/test_iperf.ml b/test/test_iperf.ml index 41ae370ae..f5d646dab 100644 --- a/test/test_iperf.ml +++ b/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 *) diff --git a/test/test_ipv4.ml b/test/test_ipv4.ml index 37835ee7b..3cfd3a244 100644 --- a/test/test_ipv4.ml +++ b/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 = [ diff --git a/test/test_ipv6.ml b/test/test_ipv6.ml index a23ded08d..fd5aa34a5 100644 --- a/test/test_ipv6.ml +++ b/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 diff --git a/test/test_rfc5961.ml b/test/test_rfc5961.ml index a9b639c8f..64453893d 100644 --- a/test/test_rfc5961.ml +++ b/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 ] diff --git a/test/test_tcp_options.ml b/test/test_tcp_options.ml index b74a9c3ca..4c0cf5e41 100644 --- a/test/test_tcp_options.ml +++ b/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 = [ diff --git a/test/test_udp.ml b/test/test_udp.ml index 6d21c688b..42e3d02cf 100644 --- a/test/test_udp.ml +++ b/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 = [ diff --git a/test/vnetif_common.ml b/test/vnetif_common.ml index a10763767..96d3bf1c1 100644 --- a/test/vnetif_common.ml +++ b/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 =