Skip to content

Commit

Permalink
CA-387699: Fix Protocol_async.with_lock bug spotted by Vincent
Browse files Browse the repository at this point in the history
Monadic concurrency libraries can switch away to another 'promise'
whenever the bind operator is called.
In fact Async will always switch away, but Lwt would only switch away if the promise is blocked
(this is probably the origin of the bug).

Move the 't.m <- true' next to where we checked that it is false to ensure that we are
the only ones holding it.
(This is still vulnerable to race conditions with pure OCaml threads, but not with Async promises).

Another alternative would be to use Async.Throttle.Sequencer, but this change is a minimal one
that could be backported to Yangtze even.

Signed-off-by: Edwin Török <[email protected]>
  • Loading branch information
edwintorok committed Jan 15, 2024
1 parent a2f11d9 commit a22f82f
Showing 1 changed file with 3 additions and 3 deletions.
6 changes: 3 additions & 3 deletions ocaml/message-switch/async/protocol_async.ml
Original file line number Diff line number Diff line change
Expand Up @@ -82,13 +82,13 @@ module M = struct

let with_lock t f =
let rec wait state =
if Bool.(t.m = state) then
if Bool.(t.m = state) then (
t.m <- true ;
return ()
else
) else
Condition.wait t.c >>= fun () -> wait state
in
wait false >>= fun () ->
t.m <- true ;
Monitor.protect f ~finally:(fun () ->
t.m <- false ;
Condition.broadcast t.c () ;
Expand Down

0 comments on commit a22f82f

Please sign in to comment.