test: send UDP regularly, stop when the first packet arrives

There's a startup delay where the stack isn't quite listening/connected/
ready to send traffic which we can't know in advance. Rather than guess
a delay, this patch makes the test case send UDP every 50s and then stop
when the first packet is received successfully.

Fixes mirage#330

Signed-off-by: David Scott <dave@recoil.org>

test/test_ipv6.ml

@@ -50,29 +50,38 @@ let listen ?(tcp = noop) ?(udp = noop) ?(default = noop) stack =
 
 let udp_message = Cstruct.of_string "hello on UDP over IPv6"
 
-let check_for_one_udp_packet netif ~src ~dst buf =
+let check_for_one_udp_packet netif on_received_one ~src ~dst buf =
   Alcotest.(check ip) "sender address" (Ipaddr.V6.of_string_exn "fc00::23") src;
   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 cstruct) "payload is correct" udp_message payload
   | Error m -> Alcotest.fail m);
+  (try Lwt.wakeup_later on_received_one () with _ -> () (* the first succeeds, the rest raise *));
   (*after receiving 1 packet, disconnect stack so test can continue*)
   V.disconnect netif
 
+let send_forever sender receiver_address udp_message =
+  let rec loop () =
+    Printf.fprintf stderr "Udp.write\n%!";
+    Udp.write sender.udp ~dst:receiver_address ~dst_port:1234 udp_message
+    >|= Rresult.R.get_ok >>= fun () ->
+    Time.sleep_ns (Duration.of_ms 50) >>= fun () ->
+    loop () in
+  loop ()
+
 let pass_udp_traffic () =
   let sender_address = Ipaddr.V6.of_string_exn "fc00::23" in
   let receiver_address = Ipaddr.V6.of_string_exn "fc00::45" in
   let backend = B.create () in
   get_stack backend sender_address >>= fun sender ->
   get_stack backend receiver_address >>= fun receiver ->
+  let received_one, on_received_one = Lwt.task () in
   Lwt.pick [
-    listen receiver ~udp:(check_for_one_udp_packet receiver.netif);
+    listen receiver ~udp:(check_for_one_udp_packet receiver.netif on_received_one);
     listen sender;
-    (* Duration.of_ms 500 makes this test fail - why? *)
-    Time.sleep_ns (Duration.of_ms 1000) >>= fun () ->
-      Udp.write sender.udp ~dst:receiver_address ~dst_port:1234 udp_message
-      >|= Rresult.R.get_ok >>= fun () ->
+    send_forever sender receiver_address udp_message;
+    received_one; (* stop on the first packet *)
       Time.sleep_ns (Duration.of_ms 3000) >>= fun () ->
       Alcotest.fail "UDP packet should have been received";
   ]