Repository: ocaml-multicore/picos
Pull request #201 (2024-08-01 08:07:13)

Move `Picos_structured.Finally` into its own lib `Picos_finally`
The `Finally` module is useful independently of the fiber management model provided by `Picos_structured`.

This also introduces a number of changes:

- The `'resource finally` type is renamed to `'resource template`.

- The `'resource moveable` type is renamed to `'resource instance`.

- The semantics of `let^` is changed such that it also releases the resource in case an exception has been raised in the scope.

- A borrow mechanism is added, as the `let&` binding operator, to allow one to use a resource acquired as a `'resource instance` before moving the resource to another scope.

- A way to explicitly `release` the resource held by an `instance` movable is also added.



Patch:
diff --git a/README.md b/README.md
index 4b5a7ac..36dd2be 100644
--- a/README.md
+++ b/README.md
@@ -40,6 +40,7 @@ either sample schedulers (e.g.
 and
 [`picos.threaded`](https://ocaml-multicore.github.io/picos/doc/picos/Picos_threaded/index.html)),
 scheduler agnostic libraries (e.g.
+[`picos.finally`](https://ocaml-multicore.github.io/picos/doc/picos/Picos_finally/index.html),
 [`picos.structured`](https://ocaml-multicore.github.io/picos/doc/picos/Picos_structured/index.html),
 [`picos.sync`](https://ocaml-multicore.github.io/picos/doc/picos/Picos_sync/index.html),
 [`picos.stdio`](https://ocaml-multicore.github.io/picos/doc/picos/Picos_stdio/index.html),
diff --git a/bench/bench_binaries.ml b/bench/bench_binaries.ml
index 99314c8..8807c60 100644
--- a/bench/bench_binaries.ml
+++ b/bench/bench_binaries.ml
@@ -1,4 +1,4 @@
-open Picos_structured.Finally
+open Picos_finally
 open Multicore_bench
 
 let lib_suffix = if Sys.os_type == "Win32" then "lib" else "a"
@@ -17,6 +17,7 @@ let paths =
     lib "picos_exn_bt";
     lib "picos_fd";
     lib "picos_fifos";
+    lib "picos_finally";
     lib "picos_htbl";
     lib "picos_lwt";
     lib "picos_lwt_unix";
diff --git a/bench/dune b/bench/dune
index 45363ab..3eed990 100644
--- a/bench/dune
+++ b/bench/dune
@@ -4,14 +4,15 @@
   (run %{test} -brief))
  (libraries
   picos
-  picos.mpscq
-  picos.htbl
-  picos.sync
   picos.domain
-  picos.thread
-  picos.stdio
+  picos.finally
+  picos.htbl
+  picos.mpscq
   picos.select
+  picos.stdio
   picos.structured
+  picos.sync
+  picos.thread
   (select
    scheduler.ml
    from
diff --git a/lib/index.mld b/lib/index.mld
index 6df0306..d3f140d 100644
--- a/lib/index.mld
+++ b/lib/index.mld
@@ -163,6 +163,7 @@ These are minimalistic, but fully-functioning, schedulers provided as samples.
 These are examples of libraries implemented in Picos.
 
 {!modules:
+  Picos_finally
   Picos_structured
   Picos_sync
   Picos_stdio
diff --git a/lib/picos_finally/dune b/lib/picos_finally/dune
new file mode 100644
index 0000000..6a09f1c
--- /dev/null
+++ b/lib/picos_finally/dune
@@ -0,0 +1,14 @@
+(library
+ (name picos_finally)
+ (public_name picos.finally)
+ (libraries picos))
+
+(mdx
+ (libraries
+  picos.exn_bt
+  picos.finally
+  picos.stdio
+  picos.structured
+  picos.sync
+  unix)
+ (files picos_finally.mli))
diff --git a/lib/picos_finally/picos_finally.ml b/lib/picos_finally/picos_finally.ml
new file mode 100644
index 0000000..6b1b597
--- /dev/null
+++ b/lib/picos_finally/picos_finally.ml
@@ -0,0 +1,138 @@
+open Picos
+
+type 'a template = ('a -> unit) * (unit -> 'a)
+
+type ('a, _) tdt =
+  | Moved : ('a, [> `Moved ]) tdt
+  | Borrowed : ('a, [> `Borrowed ]) tdt
+  | Released : ('a, [> `Released ]) tdt
+  | Resource : {
+      mutable resource : 'a;
+      release : 'a -> unit;
+      moved_or_released : Trigger.t;
+    }
+      -> ('a, [> `Resource ]) tdt
+
+type 'a instance =
+  ('a, [ `Moved | `Borrowed | `Released | `Resource ]) tdt Atomic.t
+
+let[@inline never] error (case : (_, [< `Moved | `Borrowed | `Released ]) tdt) =
+  invalid_arg
+    (match case with
+    | Moved -> "moved"
+    | Released -> "released"
+    | Borrowed -> "borrowed")
+
+let[@inline never] check_released () =
+  (* In case of cancelation we do not consider being released an error as the
+     resource was released by (the |an)other party involved in the [move]. *)
+  Fiber.check (Fiber.current ());
+  error Released
+
+let rec release movable =
+  match Atomic.get movable with
+  | Moved | Released -> ()
+  | Borrowed as case -> error case
+  | Resource r as before ->
+      if Atomic.compare_and_set movable before Released then begin
+        r.release r.resource;
+        Trigger.signal r.moved_or_released
+      end
+      else release movable
+
+let await_moved_or_released movable =
+  match Atomic.get movable with
+  | Moved | Released -> ()
+  | Borrowed as case ->
+      (* This should be impossible as [let&] should have restored the state. *)
+      error case
+  | Resource r -> begin
+      match Trigger.await r.moved_or_released with
+      | None ->
+          (* We release in case we could not wait. *)
+          release movable
+      | Some exn_bt ->
+          (* We have been canceled, so we release. *)
+          release movable;
+          Exn_bt.raise exn_bt
+    end
+
+(** This function is marked [@inline never] to ensure that there are no
+    allocations between the [acquire ()] and the [match ... with] nor before
+    [release]. *)
+let[@inline never] let_caret acquire body =
+  let x = acquire () in
+  match body x with
+  | y ->
+      await_moved_or_released x;
+      y
+  | exception exn ->
+      release x;
+      raise exn
+
+let ( let^ ) (release, acquire) body =
+  let moved_or_released = Trigger.create () in
+  let state =
+    Resource { resource = Obj.magic (); release; moved_or_released }
+  in
+  let movable = Atomic.make state in
+  (* [acquire] is called once by [let_at] before [movable] is returned, which
+     means the [Obj.magic] use below is safe. *)
+  let acquire () =
+    let (Resource r : (_, [ `Resource ]) tdt) =
+      Obj.magic (Atomic.get movable)
+    in
+    r.resource <- acquire ();
+    movable
+  in
+  let_caret acquire body
+
+let rec ( let& ) movable body =
+  match Atomic.get movable with
+  | (Moved | Released | Borrowed) as case -> error case
+  | Resource r as before ->
+      if Atomic.compare_and_set movable before Borrowed then begin
+        match body r.resource with
+        | result ->
+            Atomic.set movable before;
+            result
+        | exception exn ->
+            Atomic.set movable before;
+            raise exn
+      end
+      else ( let& ) movable body
+
+let move movable =
+  match Atomic.get movable with
+  | (Moved | Borrowed) as case -> error case
+  | Released -> (ignore, check_released)
+  | Resource r ->
+      let rec acquire () =
+        match Atomic.get movable with
+        | (Moved | Borrowed) as case -> error case
+        | Released -> check_released ()
+        | Resource r as before ->
+            if Atomic.compare_and_set movable before Moved then begin
+              (* [Trigger.signal] should never raise exceptions. *)
+              Trigger.signal r.moved_or_released;
+              r.resource
+            end
+            else acquire ()
+      in
+      (r.release, acquire)
+
+(** This function is marked [@inline never] to ensure that there are no
+    allocations between the [acquire ()] and the [match ... with] nor before
+    [release]. *)
+let[@inline never] let_at acquire body release =
+  let x = acquire () in
+  match body x with
+  | y ->
+      release x;
+      y
+  | exception exn ->
+      release x;
+      raise exn
+
+let[@inline] ( let@ ) (release, acquire) body = let_at acquire body release
+let[@inline] finally release acquire = (release, acquire)
diff --git a/lib/picos_finally/picos_finally.mli b/lib/picos_finally/picos_finally.mli
new file mode 100644
index 0000000..b68f48a
--- /dev/null
+++ b/lib/picos_finally/picos_finally.mli
@@ -0,0 +1,188 @@
+(** Syntax for avoiding resource leaks for {!Picos}.
+
+    A resource is something that is {i acquired} and must be {i released} after
+    it is no longer needed.
+
+    We open both this library and a few other libraries
+
+    {[
+      open Picos_finally
+      open Picos_structured
+      open Picos_stdio
+      open Picos_sync
+    ]}
+
+    for the examples. *)
+
+(** {1 API} *)
+
+(** {2 Resource templates} *)
+
+type 'resource template
+(** Represents a resource template of release and acquire functions. *)
+
+val finally : ('r -> unit) -> (unit -> 'r) -> 'r template
+(** [finally release acquire] returns a resource template with the given
+    [release] and [acquire] functions. *)
+
+(** {2 Managed instances}
+
+    A resource instance can be first acquired in one scope and then moved to
+    another scope. *)
+
+type 'resource instance
+(** Either contains a resource or is empty as the resource has been {{!move}
+    moved}, {{!release} released}, or has been {{!let&} borrowed}
+    temporarily. *)
+
+val ( let^ ) : 'r template -> ('r instance -> 'a) -> 'a
+(** [let^ instance = finally release acquire in scope] calls [acquire ()] to
+    obtain a resource and stores it as a resource [instance].  Then, at the end
+    of [scope], awaits that the [instance] is {{!move} moved} or {{!release}
+    released}, or {{!release} releases} the resource in case an error has been
+    raised or the fiber has been canceled.
+
+    💡 In other words, you are expected to either {!move} or {!release} the
+    resource.  [let^] only makes sure that the resource is released in case
+    something goes wrong. *)
+
+val release : 'r instance -> unit
+(** [release instance] releases the resource, if any, contained by the
+    [instance].
+
+    @raise Invalid_argument if the resource has been {{!let&} borrowed} and
+      hasn't yet been returned. *)
+
+val move : 'r instance -> 'r template
+(** [move instance] returns a resource {!template} where the acquire operation
+    atomically takes the resource from the [instance] and signals the previous
+    owner, and the release operation releases the resource.
+
+    ℹ️ [move] operates lazily such that either party in a transfer may call
+    [move].  The transfer takes place atomically at the point the {!template}
+    returned by [move] is {{!let@} bound} to a scope.
+
+    @raise Invalid_argument if the resource has been {{!let&} borrowed} and
+      hasn't yet been returned, has already been {{!move} moved}, or has been
+      {{!release} released} unless the current fiber has been canceled, in which
+      case the exception that the fiber was canceled with will be raised. *)
+
+(** {2 Naked resources}
+
+    A naked resource cannot escape the scope in which it was acquired. *)
+
+val ( let@ ) : 'r template -> ('r -> 'a) -> 'a
+(** [let@ resource = finally release acquire in scope] calls [acquire ()] to
+    obtain a [resource], evaluates [scope], and calls [release resource]
+    whether [scope] returns normally or raises an exception. *)
+
+val ( let& ) : 'r instance -> ('r -> 'a) -> 'a
+(** [let& resource = instance in scope] borrows the [resource] held by the
+    [instance] for the duration of the [scope].
+
+    @raise Invalid_argument if the resource has already been {{!let&} borrowed}
+      and hasn't yet been returned, has already been {{!release} released}, or
+      has already been {{!move} moved}. *)
+
+(** {1 Examples}
+
+    {2 Recursive server}
+
+    Here is a sketch of a server that recursively forks a fiber to accept and
+    handle a client:
+
+    {[
+      let recursive_server server_fd =
+        Bundle.join_after @@ fun bundle ->
+
+        (* recursive server *)
+        let rec accept () =
+          let@ client_fd =
+            finally Unix.close @@ fun () ->
+            Unix.accept ~cloexec:true server_fd
+            |> fst
+          in
+
+          (* fork to accept other clients *)
+          Bundle.fork bundle accept;
+
+          (* handle this client... omitted *)
+          ()
+        in
+        Bundle.fork bundle accept
+    ]}
+
+    {2 Looping server}
+
+    There is also a way to {!move} resources to allow forking fibers to handle
+    clients without leaks.
+
+    Here is a sketch of a server that accepts in a loop and forks fibers to
+    handle clients:
+
+    {[
+      let looping_server server_fd =
+        Bundle.join_after @@ fun bundle ->
+
+        (* loop to accept clients *)
+        while true do
+          let^ client_fd =
+            finally Unix.close @@ fun () ->
+            Unix.accept ~cloexec:true server_fd
+            |> fst
+          in
+
+          (* fork to handle this client *)
+          Bundle.fork bundle @@ fun () ->
+            let@ client_fd = move client_fd in
+
+            (* handle client... omitted *)
+            ()
+        done
+    ]}
+
+    {2 Move resource from child to parent}
+
+    You can {!move} a resource between any two fibers and {{!let&} borrow} it
+    before moving it.  For example, you can create a resource in a child fiber,
+    use it there, and then move it to the parent fiber:
+
+    {[
+      let move_from_child_to_parent () =
+        Bundle.join_after @@ fun bundle ->
+
+        (* for communicating a resource *)
+        let shared_ivar = Ivar.create () in
+
+        (* fork a child that creates a resource *)
+        Bundle.fork bundle begin fun () ->
+          let pretend_release () = ()
+          and pretend_acquire () = () in
+
+          (* allocate a resource *)
+          let^ instance =
+            finally pretend_release pretend_acquire
+          in
+
+          begin
+            (* borrow the resource *)
+            let& resource = instance in
+
+            (* use the resource... omitted *)
+            ()
+          end;
+
+          (* send the resource to the parent *)
+          Ivar.fill shared_ivar instance
+        end;
+
+        (* await for a resource from the child and own it *)
+        let@ resource = Ivar.read shared_ivar |> move in
+
+        (* use the resource... omitted *)
+        ()
+    ]}
+
+    The above uses an {{!Picos_sync.Ivar} [Ivar]} to communicate the movable
+    resource from the child fiber to the parent fiber.  Any concurrency safe
+    mechanism could be used. *)
diff --git a/lib/picos_select/dune b/lib/picos_select/dune
index 941f6ed..563cd2d 100644
--- a/lib/picos_select/dune
+++ b/lib/picos_select/dune
@@ -25,6 +25,7 @@
   picos
   picos.exn_bt
   picos.fifos
+  picos.finally
   picos.select
   picos.stdio
   picos.structured
diff --git a/lib/picos_select/picos_select.mli b/lib/picos_select/picos_select.mli
index 1ecf5eb..16e6739 100644
--- a/lib/picos_select/picos_select.mli
+++ b/lib/picos_select/picos_select.mli
@@ -138,7 +138,7 @@ val check_configured : unit -> unit
 
     {[
       open Picos
-      open Picos_structured.Finally
+      open Picos_finally
       open Picos_structured
       open Picos_stdio
       open Picos_sync
diff --git a/lib/picos_stdio/dune b/lib/picos_stdio/dune
index f697f0e..94146bd 100644
--- a/lib/picos_stdio/dune
+++ b/lib/picos_stdio/dune
@@ -11,5 +11,12 @@
 (mdx
  (enabled_if
   (>= %{ocaml_version} 5.1.0))
- (libraries picos picos.exn_bt picos.fifos picos.stdio picos.structured unix)
+ (libraries
+  picos
+  picos.exn_bt
+  picos.fifos
+  picos.finally
+  picos.stdio
+  picos.structured
+  unix)
  (files picos_stdio.mli))
diff --git a/lib/picos_stdio/picos_stdio.mli b/lib/picos_stdio/picos_stdio.mli
index 82f5c01..bdf0faf 100644
--- a/lib/picos_stdio/picos_stdio.mli
+++ b/lib/picos_stdio/picos_stdio.mli
@@ -689,7 +689,7 @@ end
     First we open some modules for convenience:
 
     {[
-      open Picos_structured.Finally
+      open Picos_finally
       open Picos_structured
       open Picos_stdio
     ]}
diff --git a/lib/picos_structured/dune b/lib/picos_structured/dune
index 4dcbeda..04c71c0 100644
--- a/lib/picos_structured/dune
+++ b/lib/picos_structured/dune
@@ -15,6 +15,7 @@
  (libraries
   picos.exn_bt
   picos.fifos
+  picos.finally
   picos.stdio
   picos.structured
   picos.sync
diff --git a/lib/picos_structured/finally.ml b/lib/picos_structured/finally.ml
deleted file mode 100644
index fc6e551..0000000
--- a/lib/picos_structured/finally.ml
+++ /dev/null
@@ -1,86 +0,0 @@
-open Picos
-
-type 'a finally = ('a -> unit) * (unit -> 'a)
-
-let[@inline] finally release acquire = (release, acquire)
-
-(** This function is marked [@inline never] to ensure that there are no
-    allocations between the [acquire ()] and the [match ... with] nor before
-    [release].  Allocations here would mean that e.g. pressing Ctrl-C, i.e.
-    [SIGINT], at the right moment could mean that [release] would not be called
-    after [acquire]. *)
-let[@inline never] let_at acquire body release =
-  let x = acquire () in
-  match body x with
-  | y ->
-      release x;
-      y
-  | exception exn ->
-      release x;
-      raise exn
-
-let[@inline] ( let@ ) (release, acquire) body = let_at acquire body release
-
-type ('a, _) tdt =
-  | Nothing : ('a, [> `Nothing ]) tdt
-  | Resource : {
-      mutable resource : 'a;
-      release : 'a -> unit;
-      moved : Trigger.t;
-    }
-      -> ('a, [> `Resource ]) tdt
-
-type 'a moveable = ('a, [ `Nothing | `Resource ]) tdt Atomic.t
-
-let await_moved moveable =
-  match Atomic.get moveable with
-  | Nothing -> ()
-  | Resource r -> begin
-      match Trigger.await r.moved with
-      | None -> ()
-      | Some exn_bt -> begin
-          match Atomic.exchange moveable Nothing with
-          | Nothing -> ()
-          | Resource r ->
-              r.release r.resource;
-              Exn_bt.raise exn_bt
-        end
-    end
-
-let ( let^ ) (release, acquire) body =
-  let state =
-    Resource { resource = Obj.magic (); release; moved = Trigger.create () }
-  in
-  let moveable = Atomic.make state in
-  (* [acquire] is called once by [let_at] before [moveable] is returned, which
-     means the [Obj.magic] use below is safe. *)
-  let acquire () =
-    let (Resource r : (_, [ `Resource ]) tdt) =
-      Obj.magic (Atomic.get moveable)
-    in
-    r.resource <- acquire ();
-    moveable
-  in
-  let_at acquire body await_moved
-
-let[@inline never] check_no_resource () =
-  (* In case of cancelation this is not considered an error as the resource was
-     released by (the |an)other party involved in the move.  Technically this
-     may hide a real bug where two fibers attempt to move the same resource. *)
-  Fiber.check (Fiber.current ());
-  invalid_arg "no resource to move"
-
-let nothing = (ignore, check_no_resource)
-
-let move moveable =
-  match Atomic.get moveable with
-  | Nothing -> nothing
-  | Resource r ->
-      let acquire () =
-        match Atomic.exchange moveable Nothing with
-        | Nothing -> check_no_resource ()
-        | Resource r ->
-            Trigger.signal r.moved;
-            r.resource
-      in
-      (r.release, acquire)
diff --git a/lib/picos_structured/picos_structured.ml b/lib/picos_structured/picos_structured.ml
index e356451..c589586 100644
--- a/lib/picos_structured/picos_structured.ml
+++ b/lib/picos_structured/picos_structured.ml
@@ -1,4 +1,3 @@
-module Finally = Finally
 module Control = Control
 module Promise = Promise
 module Bundle = Bundle
diff --git a/lib/picos_structured/picos_structured.mli b/lib/picos_structured/picos_structured.mli
index 3203d8c..bdf54bc 100644
--- a/lib/picos_structured/picos_structured.mli
+++ b/lib/picos_structured/picos_structured.mli
@@ -6,7 +6,7 @@
     For the {{!examples} examples} we open some modules:
 
     {[
-      open Picos_structured.Finally
+      open Picos_finally
       open Picos_structured
       open Picos_stdio
       open Picos_sync
@@ -17,102 +17,6 @@ open Picos_sync
 
 (** {1 Modules} *)
 
-module Finally : sig
-  (** Syntax for avoiding resource leaks. *)
-
-  type 'a finally = ('a -> unit) * (unit -> 'a)
-  (** A pair of release and acquire functions. *)
-
-  val finally : ('a -> unit) -> (unit -> 'a) -> 'a finally
-  (** [finally release acquire] is equivalent to [(release, acquire)]. *)
-
-  val ( let@ ) : 'a finally -> ('a -> 'b) -> 'b
-  (** [let@ resource = finally release acquire in scope] calls [acquire ()] to
-      obtain a [resource], evaluates [scope], and calls [release resource]
-      whether [scope] returns normally or raises an exception.
-
-      Here is a sketch of a server that recursively forks a fiber to accept and
-      handle a client:
-
-      {@ocaml skip[
-        Bundle.join_after @@ fun bundle ->
-        let rec accept () =
-          let@ client_fd =
-            finally Unix.close @@ fun () ->
-            Unix.accept ~cloexec:true server_fd
-            |> fst
-          in
-          (* fork to accept other clients *)
-          Bundle.fork bundle accept;
-          (* handle this client... omitted *)
-        in
-        Bundle.fork bundle accept
-      ]}
-
-      There is also a way to {!move} resources to allow forking fibers to handle
-      clients without leaks. *)
-
-  type 'a moveable
-  (** A [moveable] either contains a resource or is empty as the resource has
-      been moved. *)
-
-  val ( let^ ) : 'a finally -> ('a moveable -> 'b) -> 'b
-  (** [let^ moveable = finally release acquire in scope] calls [acquire ()] to
-      obtain a resource and stores it as a [moveable] resource.  Then, at the
-      end of [scope], awaits that the resource is {{!move} moved} out of the
-      [moveable] or [release]s the resource in case of cancelation. *)
-
-  val move : 'a moveable -> 'a finally
-  (** [move moveable] creates {{!type-finally} a pair of release and acquire
-      functions} where the acquire operation takes the resource from the
-      [moveable] and the release operation releases the resource.
-
-      Here is a sketch of a server that accepts in a loop and forks fibers to
-      handle clients:
-
-      {@ocaml skip[
-        Bundle.join_after @@ fun bundle ->
-        while true do
-          (* loop to accept clients *)
-          let^ client_fd =
-            finally Unix.close @@ fun () ->
-            Unix.accept ~closexec:true server_fd
-            |> fst
-          in
-          (* fork to handle this client *)
-          Bundle.fork bundle @@ fun () ->
-            let@ client_fd = move client_fd in
-            (* handle client... omitted *)
-        done
-      ]}
-
-      Another alternative to avoiding leaks is to {{!let@} recursively fork
-      fibers to accept and handle a client}.
-
-      You can [move] a resource between any two fibers.  For example, you can
-      move a resource from a child fiber to the parent fiber:
-
-      {@ocaml skip[
-        let moveable_ivar = Ivar.create () in
-
-        Bundle.fork bundle begin fun () ->
-          let^ moveable =
-            finally (* dispose *) (* allocate *)
-          in
-          Ivar.fill moveable_ivar moveable
-        end;
-
-        let@ res = move (Ivar.read moveable_ivar) in
-        (* ... *)
-      ]}
-
-      The above uses an {{!Picos_sync.Ivar} [Ivar]} to communicate the moveable
-      resource from the child fiber to the parent fiber.
-
-      @raise Invalid_argument if the resource has already been moved (or
-        released) unless the fiber has been canceled. *)
-end
-
 module Control : sig
   (** Basic control operations and exceptions for structured concurrency. *)
 


Test patch:
diff --git a/test/dune b/test/dune
index 650717a..b2542a2 100644
--- a/test/dune
+++ b/test/dune
@@ -26,7 +26,7 @@
  (modules test_picos)
  (libraries
   test_scheduler
-  picos.structured
+  picos.finally
   alcotest
   unix
   threads.posix
@@ -73,14 +73,25 @@
 (test
  (name test_server_and_client)
  (modules test_server_and_client)
- (libraries test_scheduler picos.stdio picos.structured picos.sync))
+ (libraries
+  test_scheduler
+  picos.finally
+  picos.stdio
+  picos.structured
+  picos.sync))
 
 ;;
 
 (test
  (name test_stdio)
  (modules test_stdio)
- (libraries test_scheduler picos.mpscq picos.stdio picos.structured alcotest))
+ (libraries
+  test_scheduler
+  picos.finally
+  picos.mpscq
+  picos.stdio
+  picos.structured
+  alcotest))
 
 ;;
 
@@ -102,6 +113,7 @@
  (name test_select)
  (modules test_select)
  (libraries
+  picos.finally
   picos.structured
   picos.threaded
   picos.select
@@ -167,6 +179,13 @@
 
 ;;
 
+(test
+ (name test_finally)
+ (modules test_finally)
+ (libraries picos picos.finally test_scheduler test_util alcotest))
+
+;;
+
 (test
  (name test_picos_lwt_unix_with_cohttp)
  (modules test_picos_lwt_unix_with_cohttp)
diff --git a/test/test_finally.ml b/test/test_finally.ml
new file mode 100644
index 0000000..e62f48e
--- /dev/null
+++ b/test/test_finally.ml
@@ -0,0 +1,38 @@
+open Picos_finally
+
+let test_move_is_lazy () =
+  Test_scheduler.run @@ fun () ->
+  let^ moveable = finally Fun.id Fun.id in
+  release moveable;
+  begin
+    match move moveable with _ -> () | exception _ -> assert false
+  end;
+  begin
+    match
+      let@ _ = move moveable in
+      ()
+    with
+    | () -> assert false
+    | exception Invalid_argument _ -> ()
+  end
+
+let test_borrow_returns_resource () =
+  Test_scheduler.run @@ fun () ->
+  let^ moveable = finally Fun.id Fun.id in
+  begin
+    let& _ = moveable in
+    ()
+  end;
+  let@ _ = move moveable in
+  ()
+
+let () =
+  [
+    ("move", [ Alcotest.test_case "is lazy" `Quick test_move_is_lazy ]);
+    ( "let&",
+      [
+        Alcotest.test_case "returns resource" `Quick
+          test_borrow_returns_resource;
+      ] );
+  ]
+  |> Alcotest.run "Picos_finally"
diff --git a/test/test_picos.ml b/test/test_picos.ml
index e4b98f4..9763412 100644
--- a/test/test_picos.ml
+++ b/test/test_picos.ml
@@ -1,5 +1,5 @@
 open Picos
-open Picos_structured.Finally
+open Picos_finally
 
 let run_in_fiber main =
   let computation = Computation.create ~mode:`LIFO () in
diff --git a/test/test_select.ml b/test/test_select.ml
index b48c74c..7b8846b 100644
--- a/test/test_select.ml
+++ b/test/test_select.ml
@@ -1,5 +1,5 @@
 open Picos_structured
-open Picos_structured.Finally
+open Picos_finally
 
 let () = Picos_select.configure ()
 
diff --git a/test/test_server_and_client.ml b/test/test_server_and_client.ml
index aa83277..7dc7751 100644
--- a/test/test_server_and_client.ml
+++ b/test/test_server_and_client.ml
@@ -1,4 +1,4 @@
-open Picos_structured.Finally
+open Picos_finally
 open Picos_structured
 open Picos_stdio
 open Picos_sync
diff --git a/test/test_stdio.ml b/test/test_stdio.ml
index 9bf2b81..e9840bc 100644
--- a/test/test_stdio.ml
+++ b/test/test_stdio.ml
@@ -1,4 +1,4 @@
-open Picos_structured.Finally
+open Picos_finally
 open Picos_structured
 open Picos_stdio
 
diff --git a/test/test_structured.ml b/test/test_structured.ml
index c7ea83c..a3871e7 100644
--- a/test/test_structured.ml
+++ b/test/test_structured.ml
@@ -1,6 +1,5 @@
 module Exn_bt = Picos.Exn_bt
 open Picos_structured
-open Picos_structured.Finally
 open Picos_sync
 
 (** Helper to check that computation is restored *)
@@ -18,22 +17,6 @@ let check join_after scope =
   assert (before != during);
   scope bundle
 
-let test_move_is_lazy () =
-  Test_scheduler.run @@ fun () ->
-  let^ moveable = finally Fun.id Fun.id in
-  let@ _ = move moveable in
-  begin
-    match move moveable with _ -> () | exception _ -> assert false
-  end;
-  begin
-    match
-      let@ _ = move moveable in
-      ()
-    with
-    | () -> assert false
-    | exception Invalid_argument _ -> ()
-  end
-
 let test_fork_after_terminate () =
   Test_scheduler.run @@ fun () ->
   check Bundle.join_after @@ fun bundle ->
@@ -296,7 +279,6 @@ let () =
   [
     ( "Bundle",
       [
-        Alcotest.test_case "move is lazy" `Quick test_move_is_lazy;
         Alcotest.test_case "fork after terminate" `Quick
           test_fork_after_terminate;
         Alcotest.test_case "fork after escape" `Quick test_fork_after_escape;