From 9f22077033c39e3749bb506adad762be802f34c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 7 Feb 2024 11:23:36 +0100 Subject: [PATCH] Use raise and reraise instead of fail in more places in unix --- src/unix/lwt_io.ml | 34 ++++++++++++++--------------- src/unix/lwt_process.cppo.ml | 10 ++++----- src/unix/lwt_unix.cppo.ml | 18 +++++++-------- test/unix/test_lwt_bytes.ml | 6 ++--- test/unix/test_lwt_engine.ml | 2 +- test/unix/test_lwt_io.ml | 6 ++--- test/unix/test_lwt_unix.ml | 18 +++++++-------- test/unix/test_mcast.ml | 6 ++--- test/unix/test_sleep_and_timeout.ml | 4 ++-- 9 files changed, 52 insertions(+), 52 deletions(-) diff --git a/src/unix/lwt_io.ml b/src/unix/lwt_io.ml index cf0b18bf0..8b3033fae 100644 --- a/src/unix/lwt_io.ml +++ b/src/unix/lwt_io.ml @@ -231,7 +231,7 @@ let perform_io : type mode. mode _channel -> int Lwt.t = fun ch -> (function | Unix.Unix_error (Unix.EPIPE, _, _) -> Lwt.return 0 - | exn -> Lwt.fail exn) [@ocaml.warning "-4"] + | exn -> Lwt.reraise exn) [@ocaml.warning "-4"] else perform ch.buffer ptr len in @@ -525,7 +525,7 @@ let make : max = (match mode with | Input -> 0 | Output -> size); - close = lazy(Lwt.catch close Lwt.fail); + close = lazy(Lwt.catch close Lwt.reraise); abort_waiter = abort_waiter; abort_wakener = abort_wakener; main = wrapper; @@ -537,7 +537,7 @@ let make : perform_io, fun pos cmd -> try seek pos cmd - with e when Lwt.Exception_filter.run e -> Lwt.fail e + with e when Lwt.Exception_filter.run e -> Lwt.reraise e ); } and wrapper = { state = Idle; @@ -678,7 +678,7 @@ struct let ptr = ic.ptr in if ptr = ic.max then refill ic >>= function - | 0 -> Lwt.fail End_of_file + | 0 -> raise End_of_file | _ -> read_char ic else begin ic.ptr <- ptr + 1; @@ -690,7 +690,7 @@ struct (fun () -> read_char ic >|= fun ch -> Some ch) (function | End_of_file -> Lwt.return_none - | exn -> Lwt.fail exn) + | exn -> Lwt.reraise exn) let read_line ic = let buf = Buffer.create 128 in @@ -711,7 +711,7 @@ struct if cr_read then Buffer.add_char buf '\r'; Lwt.return(Buffer.contents buf) | exn -> - Lwt.fail exn) + Lwt.reraise exn) in read_char ic >>= function | '\r' -> loop true @@ -723,7 +723,7 @@ struct (fun () -> read_line ic >|= fun ch -> Some ch) (function | End_of_file -> Lwt.return_none - | exn -> Lwt.fail exn) + | exn -> Lwt.reraise exn) let unsafe_read_into' ic blit buf ofs len = let avail = ic.max - ic.ptr in @@ -771,7 +771,7 @@ struct let rec loop ic buf ofs len = read_into ic buf ofs len >>= function | 0 -> - Lwt.fail End_of_file + raise End_of_file | n -> let len = len - n in if len = 0 then @@ -985,7 +985,7 @@ struct if ic.max - ic.ptr < size then refill ic >>= function | 0 -> - Lwt.fail End_of_file + raise End_of_file | _ -> read_block_unsafe ic size f else begin @@ -1440,7 +1440,7 @@ let open_temp_file ?buffer ?flags ?perm ?temp_dir ?prefix ?(suffix = "") () = Lwt.return (fname, chan)) (function | Unix.Unix_error _ when n < 1000 -> attempt (n + 1) - | exn -> Lwt.fail exn) + | exn -> Lwt.reraise exn) in attempt 0 @@ -1468,7 +1468,7 @@ let create_temp_dir Lwt.return name) (function | Unix.Unix_error (Unix.EEXIST, _, _) when n < 1000 -> attempt (n + 1) - | exn -> Lwt.fail exn) + | exn -> Lwt.reraise exn) in attempt 0 @@ -1489,10 +1489,10 @@ let win32_unlink fn = (* If everything succeeded but the final removal still failed, restore original permissions *) Lwt_unix.chmod fn st_perm >>= fun () -> - Lwt.fail exn) + Lwt.reraise exn) ) - (fun _ -> Lwt.fail exn) - | exn -> Lwt.fail exn) + (fun _ -> Lwt.reraise exn) + | exn -> Lwt.reraise exn) let unlink = if Sys.win32 then @@ -1549,7 +1549,7 @@ let close_socket fd = (function (* Occurs if the peer closes the connection first. *) | Unix.Unix_error (Unix.ENOTCONN, _, _) -> Lwt.return_unit - | exn -> Lwt.fail exn) [@ocaml.warning "-4"]) + | exn -> Lwt.reraise exn) [@ocaml.warning "-4"]) (fun () -> Lwt_unix.close fd) @@ -1574,7 +1574,7 @@ let open_connection ?fd ?in_buffer ?out_buffer sockaddr = ~mode:output (Lwt_bytes.write fd))) (fun exn -> Lwt_unix.close fd >>= fun () -> - Lwt.fail exn) + Lwt.reraise exn) let with_close_connection f (ic, oc) = (* If the user already tried to close the socket and got an exception, we @@ -1639,7 +1639,7 @@ let establish_server_generic (function | Unix.Unix_error (Unix.ECONNABORTED, _, _) -> Lwt.return `Try_again - | e -> Lwt.fail e) + | e -> Lwt.reraise e) in Lwt.pick [try_to_accept; should_stop] >>= function diff --git a/src/unix/lwt_process.cppo.ml b/src/unix/lwt_process.cppo.ml index 791e38ba7..ceb86be23 100644 --- a/src/unix/lwt_process.cppo.ml +++ b/src/unix/lwt_process.cppo.ml @@ -378,7 +378,7 @@ let read_opt read ic = (function | Unix.Unix_error (Unix.EPIPE, _, _) | End_of_file -> Lwt.return_none - | exn -> Lwt.fail exn) [@ocaml.warning "-4"] + | exn -> Lwt.reraise exn) [@ocaml.warning "-4"] let recv_chars pr = let ic = pr#stdout in @@ -512,8 +512,8 @@ let pmap ?timeout ?env ?cwd ?stderr cmd text = | Lwt.Canceled as exn -> (* Cancel the getter if the sender was canceled. *) Lwt.cancel getter; - Lwt.fail exn - | exn -> Lwt.fail exn) + Lwt.reraise exn + | exn -> Lwt.reraise exn) let pmap_chars ?timeout ?env ?cwd ?stderr cmd chars = let pr = open_process ?timeout ?env ?cwd ?stderr cmd in @@ -534,8 +534,8 @@ let pmap_line ?timeout ?env ?cwd ?stderr cmd line = | Lwt.Canceled as exn -> (* Cancel the getter if the sender was canceled. *) Lwt.cancel getter; - Lwt.fail exn - | exn -> Lwt.fail exn) + Lwt.reraise exn + | exn -> Lwt.reraise exn) let pmap_lines ?timeout ?env ?cwd ?stderr cmd lines = let pr = open_process ?timeout ?env ?cwd ?stderr cmd in diff --git a/src/unix/lwt_unix.cppo.ml b/src/unix/lwt_unix.cppo.ml index 20f73378e..5edb4b83d 100644 --- a/src/unix/lwt_unix.cppo.ml +++ b/src/unix/lwt_unix.cppo.ml @@ -147,7 +147,7 @@ let auto_pause timeout = exception Timeout -let timeout d = sleep d >>= fun () -> Lwt.fail Timeout +let timeout d = sleep d >>= fun () -> raise Timeout let with_timeout d f = Lwt.pick [timeout d; Lwt.apply f ()] @@ -582,7 +582,7 @@ let wrap_syscall event ch action = | Retry_write -> register_action Write ch action | e when Lwt.Exception_filter.run e -> - Lwt.fail e + Lwt.reraise e (* +-----------------------------------------------------------------+ | Basic file input/output | @@ -636,7 +636,7 @@ let wait_read ch = Lwt.return_unit else register_action Read ch ignore) - Lwt.fail + Lwt.reraise external stub_read : Unix.file_descr -> Bytes.t -> int -> int -> int = "lwt_unix_read" external read_job : Unix.file_descr -> Bytes.t -> int -> int -> int job = "lwt_unix_read_job" @@ -694,7 +694,7 @@ let wait_write ch = Lwt.return_unit else register_action Write ch ignore) - Lwt.fail + Lwt.reraise external stub_write : Unix.file_descr -> Bytes.t -> int -> int -> int = "lwt_unix_write" external write_job : Unix.file_descr -> Bytes.t -> int -> int -> int job = "lwt_unix_write_job" @@ -1034,7 +1034,7 @@ let file_exists name = (fun e -> match e with | Unix.Unix_error _ -> Lwt.return_false - | _ -> Lwt.fail e) [@ocaml.warning "-4"] + | _ -> Lwt.reraise e) [@ocaml.warning "-4"] external utimes_job : string -> float -> float -> unit job = "lwt_unix_utimes_job" @@ -1140,7 +1140,7 @@ struct (fun e -> match e with | Unix.Unix_error _ -> Lwt.return_false - | _ -> Lwt.fail e) [@ocaml.warning "-4"] + | _ -> Lwt.reraise e) [@ocaml.warning "-4"] end @@ -1408,7 +1408,7 @@ let files_of_directory path = (fun () -> readdir_n handle chunk_size) (fun exn -> closedir handle >>= fun () -> - Lwt.fail exn) >>= fun entries -> + Lwt.reraise exn) >>= fun entries -> if Array.length entries < chunk_size then begin state := LDS_done; closedir handle >>= fun () -> @@ -1423,7 +1423,7 @@ let files_of_directory path = (fun () -> readdir_n handle chunk_size) (fun exn -> closedir handle >>= fun () -> - Lwt.fail exn) >>= fun entries -> + Lwt.reraise exn) >>= fun entries -> if Array.length entries < chunk_size then begin state := LDS_done; closedir handle >>= fun () -> @@ -2395,7 +2395,7 @@ let () = let _waitpid flags pid = Lwt.catch (fun () -> Lwt.return (Unix.waitpid flags pid)) - Lwt.fail + Lwt.reraise let waitpid = if Sys.win32 then diff --git a/test/unix/test_lwt_bytes.ml b/test/unix/test_lwt_bytes.ml index e29843ca8..6de438b8d 100644 --- a/test/unix/test_lwt_bytes.ml +++ b/test/unix/test_lwt_bytes.ml @@ -793,7 +793,7 @@ let suite = suite "lwt_bytes" [ ) (function | Invalid_argument _message -> Lwt.return_true - | exn -> Lwt.fail exn + | exn -> Lwt.reraise exn ) end; @@ -825,7 +825,7 @@ let suite = suite "lwt_bytes" [ ) (function | Invalid_argument _message -> Lwt.return_true - | exn -> Lwt.fail exn + | exn -> Lwt.reraise exn ) end; @@ -839,7 +839,7 @@ let suite = suite "lwt_bytes" [ ) (function | Invalid_argument _message -> Lwt.return_true - | exn -> Lwt.fail exn + | exn -> Lwt.reraise exn ) end; ] diff --git a/test/unix/test_lwt_engine.ml b/test/unix/test_lwt_engine.ml index 38c7dcff1..3b6a5d231 100644 --- a/test/unix/test_lwt_engine.ml +++ b/test/unix/test_lwt_engine.ml @@ -49,7 +49,7 @@ let timing_tests = [ | Lwt_unix.Timeout -> Lwt.return (Unix.gettimeofday ()) | exn -> - Lwt.fail exn) + Lwt.reraise exn) >>= fun stop -> diff --git a/test/unix/test_lwt_io.ml b/test/unix/test_lwt_io.ml index f6bad19cd..f902f5e3e 100644 --- a/test/unix/test_lwt_io.ml +++ b/test/unix/test_lwt_io.ml @@ -320,7 +320,7 @@ let suite = suite "lwt_io" [ exceptions_observed := !exceptions_observed + 1; Lwt.return_unit | exn -> - Lwt.fail exn) [@ocaml.warning "-4"] + Lwt.reraise exn) [@ocaml.warning "-4"] in let fd_r, fd_w = Lwt_unix.pipe () in @@ -353,7 +353,7 @@ let suite = suite "lwt_io" [ let filename = ref "." in let wrap f (filename', chan) = filename := filename'; f chan in let write_data chan = Lwt_io.write chan "test file content" in - let write_data_fail _ = Lwt.fail Dummy_error in + let write_data_fail _ = Lwt.fail Dummy_error in Lwt_io.with_temp_file (wrap write_data) ~prefix >>= fun _ -> let no_temps1 = not (Sys.file_exists !filename) in Lwt.catch @@ -422,7 +422,7 @@ let suite = suite "lwt_io" [ (function | Unix.Unix_error (Unix.EISDIR, "file_length", ".") -> Lwt.return_true - | exn -> Lwt.fail exn) + | exn -> Lwt.reraise exn) end; test "input channel of_bytes initial position" diff --git a/test/unix/test_lwt_unix.ml b/test/unix/test_lwt_unix.ml index b802d867d..609ca3c2a 100644 --- a/test/unix/test_lwt_unix.ml +++ b/test/unix/test_lwt_unix.ml @@ -172,7 +172,7 @@ let utimes_tests = [ (function | Unix.Unix_error (Unix.ENOENT, "utimes", _) -> Lwt.return_unit | Unix.Unix_error (Unix.EUNKNOWNERR _, "utimes", _) -> Lwt.return_unit - | e -> Lwt.fail e) [@ocaml.warning "-4"] >>= fun () -> + | e -> Lwt.reraise e) [@ocaml.warning "-4"] >>= fun () -> Lwt.return_true); ] @@ -218,7 +218,7 @@ let readdir_tests = Lwt.return (Some filename)) (function | End_of_file -> Lwt.return_none - | exn -> Lwt.fail exn) + | exn -> Lwt.reraise exn) >>= function | None -> Lwt.return acc | Some filename -> loop (filename::acc) @@ -305,7 +305,7 @@ let readdir_tests = (function | Unix.Unix_error (Unix.EBADF, tag', _) when tag' = tag -> Lwt.return_true - | exn -> Lwt.fail exn) [@ocaml.warning "-4"] + | exn -> Lwt.reraise exn) [@ocaml.warning "-4"] in Lwt_list.for_all_s (fun (tag, t) -> expect_ebadf tag t) @@ -711,7 +711,7 @@ let writev_tests = Lwt.return_false) (function | Invalid_argument _ -> Lwt.return_true - | e -> Lwt.fail e) + | e -> Lwt.reraise e) in let close write_fd = fun () -> @@ -963,7 +963,7 @@ let bind_tests = | Unix.Unix_error (Unix.EADDRINUSE, "bind", _) | Unix.Unix_error (Unix.EISDIR, "bind", _) as exn -> if attempts <= 1 then - Lwt.fail exn + Lwt.reraise exn else bind_loop (attempts - 1) | Unix.Unix_error (Unix.EPERM, "bind", _) -> @@ -972,8 +972,8 @@ let bind_tests = test should add a check for WSL by checking for the existence of /proc/version, reading it, and checking its contents for the string "WSL". *) - Lwt.fail Skip - | e -> Lwt.fail e) [@ocaml.warning "-4"] + raise Skip + | e -> Lwt.reraise e) [@ocaml.warning "-4"] in Lwt.finalize @@ -1014,7 +1014,7 @@ let bind_tests = Lwt.return_false) (function | Unix.Unix_error (Unix.EBADF, _, _) -> Lwt.return_true - | e -> Lwt.fail e) [@ocaml.warning "-4"]); + | e -> Lwt.reraise e) [@ocaml.warning "-4"]); test "bind: aborted" (fun () -> @@ -1028,7 +1028,7 @@ let bind_tests = Lwt.return_false) (function | Exit -> Lwt.return_true - | e -> Lwt.fail e)) + | e -> Lwt.reraise e)) (fun () -> Lwt_unix.close socket)); ] diff --git a/test/unix/test_mcast.ml b/test/unix/test_mcast.ml index dbdfd446c..a44838f55 100644 --- a/test/unix/test_mcast.ml +++ b/test/unix/test_mcast.ml @@ -26,7 +26,7 @@ let child mcast_addr join fd = if debug then Printf.printf "\nReceived multicast message %S\n%!" (Bytes.unsafe_to_string (Bytes.sub buf 0 n)); if Bytes.sub buf 0 n <> hello then - Lwt.fail (Failure "unexpected multicast message") + raise (Failure "unexpected multicast message") else Lwt.return_unit @@ -61,9 +61,9 @@ let test_mcast name join set_loop = | Unix.Unix_error (Unix.EINVAL, "send", _) | Unix.Unix_error (Unix.ENODEV, "setsockopt", _) | Unix.Unix_error (Unix.ENETUNREACH, "send", _) -> - Lwt.fail Skip + raise Skip | e -> - Lwt.fail e + Lwt.reraise e ) in Lwt.finalize t (fun () -> Lwt.join [Lwt_unix.close fd1; Lwt_unix.close fd2]) diff --git a/test/unix/test_sleep_and_timeout.ml b/test/unix/test_sleep_and_timeout.ml index 40acf1385..70831ea57 100644 --- a/test/unix/test_sleep_and_timeout.ml +++ b/test/unix/test_sleep_and_timeout.ml @@ -35,7 +35,7 @@ let suite = suite "Lwt_unix sleep and timeout" [ | Lwt_unix.Timeout -> let check = cmp_elapsed_time "timeout" start_time duration in Lwt.return check - | exn -> Lwt.fail exn + | exn -> Lwt.reraise exn ) end; @@ -61,7 +61,7 @@ let suite = suite "Lwt_unix sleep and timeout" [ let check = cmp_elapsed_time "with_timeout : timeout" start_time duration in Lwt.return check - | exn -> Lwt.fail exn + | exn -> Lwt.reraise exn ) end;