Skip to content

Commit

Permalink
use Stdlib.raise and Lwt.reraise instead of Lwt.fail for better backt…
Browse files Browse the repository at this point in the history
…races
  • Loading branch information
Fermin Reig committed Oct 16, 2024
1 parent 7082341 commit d618591
Show file tree
Hide file tree
Showing 7 changed files with 8 additions and 8 deletions.
2 changes: 1 addition & 1 deletion daemon.ml
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ let wait_exit =
Bind to should_exit_lwt only once, because every bind will create an immutable waiter on
should_exit_lwt's sleeper, that is only removed after should_exit_lwt thread terminates.
*)
let thread = lazy (Lwt.bind should_exit_lwt (fun () -> Lwt.fail ShouldExit)) in
let thread = lazy (Lwt.bind should_exit_lwt (fun () -> raise ShouldExit)) in
fun () -> Lazy.force thread

(** [break_lwt = Lwt.wrap break] *)
Expand Down
2 changes: 1 addition & 1 deletion exn_lwt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -9,4 +9,4 @@ let map f x = Lwt.try_bind (fun () -> f x) (fun r -> Lwt.return (`Ok r)) (fun ex

let fail = Exn.fail

let invalid_arg fmt = ksprintf Lwt.fail_invalid_arg fmt
let invalid_arg fmt = ksprintf Stdlib.invalid_arg fmt
2 changes: 1 addition & 1 deletion httpev.ml
Original file line number Diff line number Diff line change
Expand Up @@ -606,7 +606,7 @@ let handle_lwt ?(single=false) fd k =
let pause = 2. in
log #error "too many open files, disabling accept for %s" (Time.duration_str pause);
Lwt_unix.sleep pause
| `Exn Lwt.Canceled -> log #info "canceling accept loop"; Lwt.fail Lwt.Canceled
| `Exn (Lwt.Canceled as exn) -> log #info "canceling accept loop"; raise exn
| `Exn exn -> log #warn ~exn "accept"; Lwt.return_unit
| `Ok (fd,addr as peer) ->
let task =
Expand Down
2 changes: 1 addition & 1 deletion lwt_mark.ml
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,7 @@ let with_mark v f =
let run_thread on_success on_failure func =
match func () with
| thr -> Lwt.on_any thr on_success on_failure; thr
| exception exn -> on_failure exn; Lwt.fail exn
| exception exn -> on_failure exn; Lwt.reraise exn

let mark_or_orphan id =
try Hashtbl.find marks id with Not_found -> orphan_mark
Expand Down
2 changes: 1 addition & 1 deletion lwt_util.ml
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,7 @@ let suppress_exn name cleanup t =
let action name f x =
log #info "action %s started" name;
match%lwt f x with
| exception exn -> log #error ~exn "action %s aborted" name; Lwt.fail exn
| exception exn -> log #error ~exn "action %s aborted" name; Lwt.reraise exn
| x -> log #info "action %s done" name; Lwt.return x

let action_do name f = action name f ()
Expand Down
2 changes: 1 addition & 1 deletion nix.ml
Original file line number Diff line number Diff line change
Expand Up @@ -308,7 +308,7 @@ let connect_lwt fd sockaddr =
let open Lwt_unix in
Lwt.catch
(fun () -> connect fd sockaddr)
(function Unix_error (e, f, "") -> Lwt.fail (Unix_error (e, f, show_addr sockaddr)) | exn -> Lwt.fail exn)
(function Unix_error (e, f, "") -> raise (Unix_error (e, f, show_addr sockaddr)) | exn -> Lwt.reraise exn)

let get_xdg_dir ~env dir =
try Sys.getenv env with Not_found ->
Expand Down
4 changes: 2 additions & 2 deletions web.ml
Original file line number Diff line number Diff line change
Expand Up @@ -359,8 +359,8 @@ module IO_lwt = struct
let bracket mresource destroy k =
let%lwt resource = mresource in
(k resource) [%finally destroy resource]
let fail = Exn_lwt.fail
let raise = Lwt.fail
let fail = Exn.fail
let raise = raise
let sleep = Lwt_unix.sleep
let map_s = Lwt_list.map_s
let catch = Lwt.catch
Expand Down

0 comments on commit d618591

Please sign in to comment.