Tests: cleanup P2P tests output

This commit is contained in:
Benjamin Canou 2017-12-04 15:50:50 +01:00
parent d3f91f05a2
commit 0967c7fde7
2 changed files with 70 additions and 10 deletions

View File

@ -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 _ ->

View File

@ -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