From b7b1c74b43dd5403d9d087845c8098b197ad0969 Mon Sep 17 00:00:00 2001 From: Estevan Castilho Date: Thu, 8 Oct 2026 00:09:56 +0000 Subject: Make `Handle.release` concurrency-safe --- lib/protocols/Handle.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lib/protocols/Handle.ml') diff --git a/lib/protocols/Handle.ml b/lib/protocols/Handle.ml index 2514a7f..add2e1c 100644 --- a/lib/protocols/Handle.ml +++ b/lib/protocols/Handle.ml @@ -17,14 +17,14 @@ class type obj = object method protocols : protocol list end -type t = {valid: bool ref; refers_to: obj} +type t = {valid: bool Atomic.t; refers_to: obj} type 'a interface = {handle: t; interface: 'a} let object_of {valid; refers_to} = - if !valid then refers_to else failwith "Attempt to dereference an invalid handle!" + if (Atomic.get valid) then refers_to else failwith "Attempt to dereference an invalid handle!" let interface_of handle interface = {handle; interface} -let make o = {valid= ref true; refers_to= (o :> obj)} +let make o = {valid= Atomic.make true; refers_to= (o :> obj)} let into handle f = List.find_map f (object_of handle)#protocols |> Option.map (interface_of handle) let invoke {handle; interface} f = @@ -44,7 +44,7 @@ let to_string h = let o = (object_of h) in "#<" ^ o#to_string ^ " " ^ (Concepts. let release ({valid; _} as handle) = let o = object_of handle in - valid := false; - o#release + if Atomic.compare_and_set valid true false then + o#release let require f h = Option.to_result ~none:(Error.unimplemented_protocol (to_string h)) (f h) -- cgit v1.2.3