From 0967c7fde7489f93122ac1a17340299b67879318 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Mon, 4 Dec 2017 15:50:50 +0100
Subject: [PATCH] Tests: cleanup P2P tests output

---
 test/lib/process.ml                  | 57 +++++++++++++++++++++++++---
 test/p2p/test_p2p_connection_pool.ml | 23 +++++++++--
 2 files changed, 70 insertions(+), 10 deletions(-)

diff --git a/test/lib/process.ml b/test/lib/process.ml
index b4b242af0..00662525e 100644
--- a/test/lib/process.ml
+++ b/test/lib/process.ml
@@ -12,6 +12,8 @@ let () = Lwt_unix.set_default_async_method Async_none
 include Logging.Make (struct let name = "process" end)
 
 exception Exited of int
+exception Signaled of int
+exception Stopped of int
 
 let handle_error f =
   Lwt.catch
@@ -42,9 +44,10 @@ let wait pid =
            return ()
        | (_,Lwt_unix.WEXITED n) ->
            fail (Exn (Exited n))
-       | (_,Lwt_unix.WSIGNALED _)
-       | (_,Lwt_unix.WSTOPPED _) ->
-           Lwt.fail Exit)
+       | (_,Lwt_unix.WSIGNALED n) ->
+           fail (Exn (Signaled n))
+       | (_,Lwt_unix.WSTOPPED n) ->
+           fail (Exn (Stopped n)))
     (function
       | Lwt.Canceled ->
           Unix.kill pid Sys.sigkill ;
@@ -70,7 +73,7 @@ let detach ?(prefix = "") f =
         Lwt_io.close main_in >>= fun () ->
         Lwt_io.close main_out >>= fun () ->
         Logging.init ~template Stderr >>= fun () ->
-        lwt_log_info "PID: %d" (Unix.getpid ()) >>= fun () ->
+        lwt_log_notice "PID: %d" (Unix.getpid ()) >>= fun () ->
         handle_error (fun () -> f (child_in, child_out))
       end ;
       exit 0
@@ -78,7 +81,39 @@ let detach ?(prefix = "") f =
       let termination = wait pid in
       Lwt_io.close child_in >>= fun () ->
       Lwt_io.close child_out >>= fun () ->
-      Lwt.return { termination ; channel = (main_in, main_out) }
+      Lwt.return ({ termination ; channel = (main_in, main_out) })
+
+let signal_name =
+  let names =
+    [ Sys.sigabrt, "ABRT" ;
+      Sys.sigalrm, "ALRM" ;
+      Sys.sigfpe, "FPE" ;
+      Sys.sighup, "HUP" ;
+      Sys.sigill, "ILL" ;
+      Sys.sigint, "INT" ;
+      Sys.sigkill, "KILL" ;
+      Sys.sigpipe, "PIPE" ;
+      Sys.sigquit, "QUIT" ;
+      Sys.sigsegv, "SEGV" ;
+      Sys.sigterm, "TERM" ;
+      Sys.sigusr1, "USR1" ;
+      Sys.sigusr2, "USR2" ;
+      Sys.sigchld, "CHLD" ;
+      Sys.sigcont, "CONT" ;
+      Sys.sigstop, "STOP" ;
+      Sys.sigtstp, "TSTP" ;
+      Sys.sigttin, "TTIN" ;
+      Sys.sigttou, "TTOU" ;
+      Sys.sigvtalrm, "VTALRM" ;
+      Sys.sigprof, "PROF" ;
+      Sys.sigbus, "BUS" ;
+      Sys.sigpoll, "POLL" ;
+      Sys.sigsys, "SYS" ;
+      Sys.sigtrap, "TRAP" ;
+      Sys.sigurg, "URG" ;
+      Sys.sigxcpu, "XCPU" ;
+      Sys.sigxfsz, "XFSZ" ] in
+  fun n -> List.assoc n names
 
 let wait_all processes =
   let rec loop processes =
@@ -102,8 +137,18 @@ let wait_all processes =
       List.iter Lwt.cancel remaining ;
       join remaining >>= fun _ ->
       failwith "A process finished with error %d !" n
+  | Some ([Exn (Signaled n)], remaining) ->
+      lwt_log_error "Early error!" >>= fun () ->
+      List.iter Lwt.cancel remaining ;
+      join remaining >>= fun _ ->
+      failwith "A process was killed by a SIG%s !" (signal_name n)
+  | Some ([Exn (Stopped n)], remaining) ->
+      lwt_log_error "Early error!" >>= fun () ->
+      List.iter Lwt.cancel remaining ;
+      join remaining >>= fun _ ->
+      failwith "A process was stopped by a SIG%s !" (signal_name n)
   | Some (err, remaining) ->
-      lwt_log_error "Unexpected error!%a"
+      lwt_log_error "@[<v 2>Unexpected error!@,%a@]"
         pp_print_error err >>= fun () ->
       List.iter Lwt.cancel remaining ;
       join remaining >>= fun _ ->
diff --git a/test/p2p/test_p2p_connection_pool.ml b/test/p2p/test_p2p_connection_pool.ml
index 97f55c770..3b1dbc8ea 100644
--- a/test/p2p/test_p2p_connection_pool.ml
+++ b/test/p2p/test_p2p_connection_pool.ml
@@ -124,10 +124,23 @@ module Simple = struct
              | P2p_connection.Rejected
              | Lwt_utils.Canceled
              | Lwt_utils.Timeout
-             | P2p_connection_pool.Rejected _
-             ] as err) ->
-        lwt_log_info "@[Connection to %a failed:@ %a@]"
-          Point.pp point pp_print_error err >>= fun () ->
+             | P2p_connection_pool.Rejected _ as err ]) ->
+        lwt_log_info "Connection to %a failed (%a)"
+          Point.pp point
+          (fun ppf err -> match err with
+             | P2p_connection_pool.Connection_refused ->
+                 Format.fprintf ppf "connection refused"
+             | P2p_connection_pool.Pending_connection ->
+                 Format.fprintf ppf "pending connection"
+             | P2p_connection.Rejected ->
+                 Format.fprintf ppf "rejected"
+             | Lwt_utils.Canceled ->
+                 Format.fprintf ppf "canceled"
+             | Lwt_utils.Timeout ->
+                 Format.fprintf ppf "timeout"
+             | P2p_connection_pool.Rejected peer ->
+                 Format.fprintf ppf "rejected (%a)" Peer_id.pp peer
+             | _ -> assert false) err >>= fun () ->
         Lwt_unix.sleep (0.5 +. Random.float 2.) >>= fun () ->
         connect ~timeout pool point
     | Ok _ | Error _ as res -> Lwt.return res
@@ -234,6 +247,8 @@ module Garbled = struct
 
 end
 
+let () = Random.self_init ()
+
 let addr = ref Ipaddr.V6.localhost
 let port = ref (1024 + Random.int 8192)
 let clients = ref 10