Note and test that certain operations are not cancelable

This can help to simplify and optimize code in some cases as these operations
are often used in finalizers.

Author: polytypic

lib/picos_std.sync/picos_std_sync.mli

@@ -59,6 +59,8 @@ module Mutex : sig
   val unlock : ?checked:bool -> t -> unit
   (** [unlock mutex] unlocks the mutex.
 
+      ℹ️ This operation is not cancelable.
+
       @raise Sys_error if the mutex was locked by another fiber.  If
         [~checked:false] was specified for some previous operation on the mutex
         the exception may or may not be raised. *)
@@ -128,6 +130,8 @@ module Semaphore : sig
     val release : t -> unit
     (** [release semaphore] increments the count of the semaphore.
 
+        ℹ️ This operation is not cancelable.
+
         @raise Sys_error in case the count would overflow. *)
 
     val acquire : t -> unit
@@ -154,7 +158,9 @@ module Semaphore : sig
         [initial] is [true] and count of [0] otherwise. *)
 
     val release : t -> unit
-    (** [release semaphore] sets the count of the semaphore to [1]. *)
+    (** [release semaphore] sets the count of the semaphore to [1].
+
+        ℹ️ This operation is not cancelable. *)
 
     val acquire : t -> unit
     (** [acquire semaphore] waits until the count of the semaphore is [1] and
@@ -259,6 +265,8 @@ module Latch : sig
           invalid_arg "zero count"
       ]}
 
+      ℹ️ This operation is not cancelable.
+
       @raise Invalid_argument in case the count of the latch is zero. *)
 
   val try_incr : t -> bool
@@ -309,7 +317,9 @@ module Ivar : sig
   (** [try_poison_at ivar exn bt] attempts to poison the incremental variable
       with the specified exception and backtrace.  Returns [true] on success and
       [false] in case the variable had already been poisoned or assigned a
-      value. *)
+      value.
+
+      ℹ️ This operation is not cancelable. *)
 
   val try_poison : ?callstack:int -> 'a t -> exn -> bool
   (** [try_poison ivar exn] is equivalent to
@@ -364,7 +374,9 @@ module Stream : sig
   val poison_at : 'a t -> exn -> Printexc.raw_backtrace -> unit
   (** [poison_at stream exn bt] marks the stream as poisoned at the current
       position, which means that subsequent attempts to {!push} to the [stream]
-      will raise the given exception with backtrace. *)
+      will raise the given exception with backtrace.
+
+      ℹ️ This operation is not cancelable. *)
 
   val poison : ?callstack:int -> 'a t -> exn -> unit
   (** [poison stream exn] is equivalent to

test/dune

@@ -59,6 +59,7 @@
    (run %{test} -- "Lazy" 1)
    (run %{test} -- "Semaphore" 0)
    (run %{test} -- "Semaphore" 1)
+   (run %{test} -- "Non-cancelable ops" 0)
    (run %{test} -- "Mutex and Condition" 0)
    (run %{test} -- "Mutex and Condition" 1)
    (run %{test} -- "Mutex and Condition" 2))))

test/test_sync.ml

@@ -287,6 +287,26 @@ let test_event_basics () =
     | exception Exit -> ()
   end
 
+let test_non_cancelable_ops () =
+  Test_scheduler.run @@ fun () ->
+  let ivar = Ivar.create () in
+  let stream = Stream.create () in
+  let latch = Latch.create 1 in
+  let mutex = Mutex.create () in
+  let counting = Semaphore.Counting.make 0 in
+  let binary = Semaphore.Binary.make false in
+  Flock.join_after @@ fun () ->
+  Mutex.lock ~checked:(Random.bool ()) mutex;
+  Flock.terminate ();
+  try
+    Ivar.poison ivar Exit;
+    Stream.poison stream Exit;
+    Latch.decr latch;
+    Mutex.unlock ~checked:(Random.bool ()) mutex;
+    Semaphore.Counting.release counting;
+    Semaphore.Binary.release binary
+  with _ -> assert false
+
 let () =
   try
     [
@@ -308,6 +328,9 @@ let () =
           Alcotest.test_case "cancelation" `Quick test_lazy_cancelation;
         ] );
       ("Event", [ Alcotest.test_case "basics" `Quick test_event_basics ]);
+      ( "Non-cancelable ops",
+        [ Alcotest.test_case "are not canceled" `Quick test_non_cancelable_ops ]
+      );
     ]
     |> Alcotest.run ~and_exit:false "Picos_sync";
     !msgs |> List.iter (Printf.eprintf "%s\n%!")