1 files changed, 33 insertions, 6 deletions

diff --git a/test/unit/kernel/Session.ml b/test/unit/kernel/Session.ml
index 3ae549f..79ad5a2 100644
--- a/test/unit/kernel/Session.ml
+++ b/test/unit/kernel/Session.ml
@@ -22,21 +22,25 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
         let open Rnt.Kernel.Path in
         let* root = I.initialize conn in
         let* branch = B.make conn in
-        let* _ = update root ("branch" @/ this) "master" None (Some branch) in
+        let* _ = update root ("system" @/ "branch" @/ this) "client" None (Some branch) in
         let* tip = address branch in
         let session = Session.make conn {Protocols.Session.snapshot= tip} in
-        let* _ = update root ("session" @/ this) "client" None (Protocols.Handle.copy session) in
-        let library = "session" @/ "client" @/ "branch" @/ "multigroup" @/ "library" @/ this in
+        let* _ = update root ("system" @/ "session" @/ this) "client" None (Some session) in
+        let library =
+          "system" @/ "session" @/ "client" @/ "branch" @/ "multigroup" @/ "library" @/ this
+        in
         let before = finds root library in
         let* multigroup = M.make conn in
         let* branch' = assoc branch ("multigroup" @/ this) "library" (Some multigroup) in
-        let* _ = update root ("branch" @/ this) "master" (Some branch) (Some branch') in
+        let* _ = update root ("system" @/ "branch" @/ this) "client" (Some branch) (Some branch') in
         let unchanged = finds root library in
         let* tip' = address branch' in
         let* interface = Protocols.Handle.require Protocols.Session.from session in
         Protocols.Session.pin interface {Protocols.Session.snapshot= tip'};
         let after = finds root library in
-        let* pinned = lookup root ("session" @/ "client" @/ "branch" @/ this) |> fmap address in
+        let* pinned =
+          lookup root ("system" @/ "session" @/ "client" @/ "branch" @/ this) |> fmap address
+        in
         let refused =
           assoc session ("branch" @/ "multigroup" @/ this) "other" (Some multigroup)
           |> Result.is_error
@@ -51,9 +55,32 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) =
     check bool "the session reconstructs the pinned branch" true pinned;
     check bool "the session refuses derivation through it" true refused
 
+  let single_handle conn =
+    let refused, reacquired =
+      begin
+        let open Utilities.Result in
+        let open Rnt.Kernel.Path in
+        let* root = I.initialize conn in
+        let* branch = B.make conn in
+        let* tip = address branch in
+        let session = Session.make conn {Protocols.Session.snapshot= tip} in
+        let* _ = update root ("system" @/ "session" @/ this) "client" None (Some session) in
+        let client = "system" @/ "session" @/ "client" @/ this in
+        let* _ = lookup root ("system" @/ "session" @/ "client" @/ "branch" @/ this) in
+        let* held = lookup root client in
+        let refused = finds root client in
+        Protocols.Handle.release held;
+        Ok (refused, finds root client)
+      end
+      |> Helpers.condition_as_failure
+    in
+    check bool "a second handle to the session is refused" false refused;
+    check bool "releasing the handle frees the session" true reacquired
+
   let suite =
     ( "kernel/session",
-      [test_case "pin-and-follow" `Quick (H.with_connection pin_and_follow "session-test")] )
+      [ test_case "pin-and-follow" `Quick (H.with_connection pin_and_follow "session-test");
+        test_case "single-handle" `Quick (H.with_connection single_handle "session-single-test") ] )
 end
 
 module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)