From 9b30a5de03aaa3057984559f11456355231351d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Mon, 22 Jul 2024 16:53:28 +0200 Subject: [PATCH] Use Stdlib.raise instead of Lwt.fail to capture backtraces --- cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml | 2 +- cohttp-lwt-unix/src/io.ml | 4 ++-- cohttp-lwt-unix/src/server.ml | 4 ++-- cohttp-lwt-unix/test/test_client.ml | 6 +++--- cohttp-lwt/src/connection.ml | 2 +- cohttp-lwt/src/connection_cache.ml | 4 ++-- cohttp-mirage/src/input_channel.ml | 2 +- cohttp-mirage/src/io.ml | 2 +- 8 files changed, 13 insertions(+), 13 deletions(-) diff --git a/cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml b/cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml index b0422d7437..2d68024316 100644 --- a/cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml +++ b/cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml @@ -188,7 +188,7 @@ struct (* No implementation (can it be done?). What should the failure exception be? *) exception Cohttp_lwt_xhr_callv_not_implemented - let callv ?ctx:_ _uri _reqs = Lwt.fail Cohttp_lwt_xhr_callv_not_implemented + let callv ?ctx:_ _uri _reqs = raise Cohttp_lwt_xhr_callv_not_implemented (* ??? *) end diff --git a/cohttp-lwt-unix/src/io.ml b/cohttp-lwt-unix/src/io.ml index 2e22cb952d..0fd496dd6a 100644 --- a/cohttp-lwt-unix/src/io.ml +++ b/cohttp-lwt-unix/src/io.ml @@ -40,12 +40,12 @@ let wrap_read f ~if_closed = https://github.com/ocsigen/lwt/pull/635 *) Lwt.catch f (function | Lwt_io.Channel_closed _ -> Lwt.return if_closed - | Unix.Unix_error _ as e -> Lwt.fail (IO_error e) + | Unix.Unix_error _ as e -> raise (IO_error e) | exn -> raise exn) let wrap_write f = Lwt.catch f (function - | Unix.Unix_error _ as e -> Lwt.fail (IO_error e) + | Unix.Unix_error _ as e -> raise (IO_error e) | exn -> raise exn) let read_line ic = diff --git a/cohttp-lwt-unix/src/server.ml b/cohttp-lwt-unix/src/server.ml index 2f581f9071..6aa5ccd90c 100644 --- a/cohttp-lwt-unix/src/server.ml +++ b/cohttp-lwt-unix/src/server.ml @@ -16,8 +16,8 @@ let respond_file ?headers ~fname () = (fun () -> (* Check this isn't a directory first *) ( fname |> Lwt_unix.stat >>= fun s -> - if Unix.(s.st_kind <> S_REG) then Lwt.fail Isnt_a_file - else Lwt.return_unit ) + if Unix.(s.st_kind <> S_REG) then raise Isnt_a_file else Lwt.return_unit + ) >>= fun () -> let count = 16384 in Lwt_io.open_file ~buffer:(Lwt_bytes.create count) ~mode:Lwt_io.input fname diff --git a/cohttp-lwt-unix/test/test_client.ml b/cohttp-lwt-unix/test/test_client.ml index 07c6520880..8ab5c34bd5 100644 --- a/cohttp-lwt-unix/test/test_client.ml +++ b/cohttp-lwt-unix/test/test_client.ml @@ -59,13 +59,13 @@ let methods (handler : Cohttp_lwt.S.call) uri = handler `GET Uri.(with_path uri k) >>= fun (res, body) -> match Response.status res with | `OK | `No_content -> Body.to_string body - | _ -> Body.drain_body body >>= fun () -> Lwt.fail Not_found + | _ -> Body.drain_body body >>= fun () -> raise Not_found and delete k = handler `DELETE Uri.(with_path uri k) >>= fun (res, body) -> Body.drain_body body >>= fun () -> match Response.status res with | `OK | `No_content -> Lwt.return_unit - | _ -> Lwt.fail Not_found + | _ -> raise Not_found and mem k = handler `HEAD Uri.(with_path uri k) >>= fun (res, body) -> Body.drain_body body >|= fun () -> @@ -171,7 +171,7 @@ let test_unknown uri = connection := c; match body with (* Still, body may have been (partially) consumed and needs re-creation. *) - | Some (`Stream _) -> Lwt.fail Connection.Retry + | Some (`Stream _) -> raise Connection.Retry | None | Some (`Empty | `String _ | `Strings _) -> handler ?headers ?body meth uri) | e -> Lwt.reraise e) diff --git a/cohttp-lwt/src/connection.ml b/cohttp-lwt/src/connection.ml index a4b94916a3..879ed0810b 100644 --- a/cohttp-lwt/src/connection.ml +++ b/cohttp-lwt/src/connection.ml @@ -172,7 +172,7 @@ module Make (Net : S.Net) : S.Connection with module Net = Net = struct Queue.push { uri; meth; headers; body; res_r } connection.waiting; Lwt_condition.broadcast connection.condition (); res - | Closing _ | Half _ | Closed | Failed _ -> Lwt.fail Retry + | Closing _ | Half _ | Closed | Failed _ -> raise Retry let rec writer connection = match connection.state with diff --git a/cohttp-lwt/src/connection_cache.ml b/cohttp-lwt/src/connection_cache.ml index 74a584111f..0dd46432d7 100644 --- a/cohttp-lwt/src/connection_cache.ml +++ b/cohttp-lwt/src/connection_cache.ml @@ -161,9 +161,9 @@ end = struct (function | Retry -> ( match body with - | Some (`Stream _) -> Lwt.fail Retry + | Some (`Stream _) -> raise Retry | None | Some `Empty | Some (`String _) | Some (`Strings _) -> - if retry <= 0 then Lwt.fail Retry else request (retry - 1)) + if retry <= 0 then raise Retry else request (retry - 1)) | e -> Lwt.reraise e) in request self.retry diff --git a/cohttp-mirage/src/input_channel.ml b/cohttp-mirage/src/input_channel.ml index 96e2e62101..7b1b1f3b62 100644 --- a/cohttp-mirage/src/input_channel.ml +++ b/cohttp-mirage/src/input_channel.ml @@ -13,7 +13,7 @@ module Make (Channel : Mirage_channel.S) = struct Cstruct.blit_to_bytes v 0 buf pos len; Lwt.return (`Ok len) | Ok `Eof -> Lwt.return `Eof - | Error e -> Lwt.fail (Read_exn e) + | Error e -> raise (Read_exn e) let create ?(buf_len = 0x4000) chan = { buf = Bytebuffer.create buf_len; chan } diff --git a/cohttp-mirage/src/io.ml b/cohttp-mirage/src/io.ml index 1e20f8b03e..d8215037aa 100644 --- a/cohttp-mirage/src/io.ml +++ b/cohttp-mirage/src/io.ml @@ -55,7 +55,7 @@ module Make (Channel : Mirage_channel.S) = struct Channel.flush oc >>= function | Ok () -> Lwt.return_unit | Error `Closed -> failwith "Trying to write on closed channel" - | Error e -> Lwt.fail (Write_exn e) + | Error e -> raise (Write_exn e) let flush _ = (* NOOP since we flush in the normal writer functions above *)