Fix mis-write of k* into Cstruct_append

src/git/cstruct_append.ml

@@ -103,14 +103,14 @@ let create ~mode:_ { o0; o1; _ } key =
     let k1 =
       Option.fold ~none:false
         ~some:(fun key' -> key == key')
-        (Ephemeron.K1.get_key o0)
+        (Ephemeron.K1.get_key o1)
     in
     assert (not (k0 && k1));
     let value =
       if k0 then Option.get (Ephemeron.K1.get_data o0)
       else Option.get (Ephemeron.K1.get_data o1)
     in
-    k1, value
+    k0, value
   in
 
   let value =
@@ -121,6 +121,7 @@ let create ~mode:_ { o0; o1; _ } key =
     else !value
   in
 
+  Log.debug (fun m -> m "Make a new file-descriptor (%b)." which);
   let fd =
     {
       buffer = value;
@@ -137,9 +138,11 @@ let append _ fd str =
   if new_length > fd.capacity then enlarge fd len;
   Cstruct.blit_from_string str 0 fd.buffer fd.length len;
   fd.length <- new_length;
+  Log.debug (fun m -> m "Append + %d byte(s)." fd.length);
   Lwt.return ()
 
 let map _ fd ~pos len =
+  Log.debug (fun m -> m "map on fd(length:%d) ~pos:%Ld %d." fd.length pos len);
   let pos = Int64.to_int pos in
   if pos > fd.length then Lwt.return Bigstringaf.empty
   else
@@ -148,8 +151,10 @@ let map _ fd ~pos len =
     Lwt.return (Bigstringaf.sub ~off:(off + pos) ~len buffer)
 
 let close tbl fd =
-  Log.debug (fun m -> m "Close the object into the cstruct-append heap.");
   let result = Cstruct.sub fd.buffer 0 fd.length in
+  Log.debug (fun m ->
+      m "Close the object into the cstruct-append heap (save %d bytes)."
+        fd.length);
   ( if fd.which then
     match Ephemeron.K1.get_data tbl.o0 with
     | Some value -> value := result
@@ -187,6 +192,6 @@ let project tbl uid =
   else if
     Option.fold ~none:false
       ~some:(fun k -> k == uid)
-      (Ephemeron.K1.get_key tbl.o0)
+      (Ephemeron.K1.get_key tbl.o1)
   then !(Option.get (Ephemeron.K1.get_data tbl.o1))
   else Cstruct.empty

src/git/git.ml

@@ -19,3 +19,4 @@ module Mem = Mem
 module Store = Store
 module Hash = Hash
 module Sync = Sync
+module Cstruct_append = Cstruct_append

src/git/git.mli

@@ -16,5 +16,6 @@ module Mem = Mem
 module Store = Store
 module Hash = Hash
 module Sync = Sync
+module Cstruct_append = Cstruct_append
 
 module type S = Minimal.S

test/cstruct_append/dune

@@ -0,0 +1,11 @@
+(executable
+ (name test)
+ (libraries fmt fmt.tty logs.cli logs.fmt lwt lwt.unix git alcotest-lwt
+   bigstringaf cstruct alcotest))
+
+(rule
+ (alias runtest)
+ (deps
+  (:test test.exe))
+ (action
+  (run %{test} --color=always)))

test/cstruct_append/test.ml

@@ -0,0 +1,126 @@
+let reporter ppf =
+  let report src level ~over k msgf =
+    let k _ =
+      over ();
+      k ()
+    in
+    let with_metadata header _tags k ppf fmt =
+      Format.kfprintf k ppf
+        ("%a[%a]: " ^^ fmt ^^ "\n%!")
+        Logs_fmt.pp_header (level, header)
+        Fmt.(styled `Magenta string)
+        (Logs.Src.name src)
+    in
+    msgf @@ fun ?header ?tags fmt -> with_metadata header tags k ppf fmt
+  in
+  { Logs.report }
+
+let () = Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ()
+let () = Logs.set_reporter (reporter Fmt.stderr)
+let () = Logs.set_level ~all:true (Some Logs.Debug)
+
+open Lwt.Infix
+open Git
+
+let with_fd ~mode ~f device uid acc =
+  Cstruct_append.create ~mode device uid >>= function
+  | Ok fd ->
+      f fd acc >>= fun acc ->
+      Cstruct_append.close device fd >>= fun _ ->
+      Gc.full_major ();
+      Lwt.return acc
+  | Error err -> Alcotest.failf "%a" Cstruct_append.pp_error err
+
+let test_simple_use =
+  Alcotest_lwt.test_case "simple use" `Quick @@ fun _sw () ->
+  let device = Cstruct_append.device () in
+  let a = Cstruct_append.key device in
+  with_fd ~mode:Wr ~f:(Cstruct_append.append device) device a "Hello World!"
+  >>= fun () ->
+  Gc.full_major ();
+  let v = Cstruct_append.project device a in
+  Gc.full_major ();
+  Alcotest.(check string) "contents" (Cstruct.to_string v) "Hello World!";
+  Lwt.return_unit
+
+(* XXX(dinosaure): any (re-)open of a filename/uid will be truncated
+ * to length 0 (as [Unix.O_TRUNC]). *)
+let test_trunk_mode =
+  Alcotest_lwt.test_case "O_TRUNC" `Quick @@ fun _sw () ->
+  let device = Cstruct_append.device () in
+  let a = Cstruct_append.key device in
+  with_fd ~mode:Wr ~f:(Cstruct_append.append device) device a "Hello World!"
+  >>= fun () ->
+  Gc.full_major ();
+  with_fd ~mode:Rd
+    ~f:(fun fd _ -> Cstruct_append.map device fd ~pos:0L 12)
+    device a Bigstringaf.empty
+  >>= fun v ->
+  Gc.full_major ();
+  Alcotest.(check string) "contents" (Bigstringaf.to_string v) "";
+  Lwt.return_unit
+
+let test_two_contents =
+  Alcotest_lwt.test_case "two contents" `Quick @@ fun _sw () ->
+  let device = Cstruct_append.device () in
+  let a = Cstruct_append.key device in
+  let b = Cstruct_append.key device in
+  with_fd ~mode:Wr ~f:(Cstruct_append.append device) device a "foo"
+  >>= fun () ->
+  Gc.full_major ();
+  with_fd ~mode:Wr ~f:(Cstruct_append.append device) device b "bar"
+  >>= fun () ->
+  Gc.full_major ();
+  let va = Cstruct_append.project device a in
+  Gc.full_major ();
+  let vb = Cstruct_append.project device b in
+  Gc.full_major ();
+  Alcotest.(check string) "contents" (Cstruct.to_string va) "foo";
+  Alcotest.(check string) "contents" (Cstruct.to_string vb) "bar";
+  Lwt.return_unit
+
+let test_three_contents =
+  Alcotest_lwt.test_case "three contents" `Quick @@ fun _sw () ->
+  let device = Cstruct_append.device () in
+  let a = Cstruct_append.key device in
+  let b = Cstruct_append.key device in
+  let c = Cstruct_append.key device in
+  with_fd ~mode:Wr ~f:(Cstruct_append.append device) device a "foo"
+  >>= fun () ->
+  Gc.full_major ();
+  with_fd ~mode:Wr ~f:(Cstruct_append.append device) device b "bar"
+  >>= fun () ->
+  Gc.full_major ();
+  with_fd ~mode:RdWr
+    ~f:(fun fd str ->
+      Cstruct_append.map device fd ~pos:0L 3 >>= fun v ->
+      Alcotest.(check string) "contents" (Bigstringaf.to_string v) "";
+      (* O_TRUNC *)
+      Cstruct_append.append device fd str)
+    device c "lol"
+  >>= fun () ->
+  Gc.full_major ();
+  let va = Cstruct_append.project device a in
+  Gc.full_major ();
+  let vb = Cstruct_append.project device b in
+  Gc.full_major ();
+  let vc = Cstruct_append.project device c in
+  Gc.full_major ();
+  Alcotest.(check string) "contents" (Cstruct.to_string va) "";
+  (* XXX(dinosaure): if [uid] ([a], [b] or [c]) is not physically the same as
+   * what the [device] has, we return [Cstruct.empty]. *)
+  Alcotest.(check string) "contents" (Cstruct.to_string vb) "bar";
+  Alcotest.(check string) "contents" (Cstruct.to_string vc) "lol";
+  Lwt.return_unit
+
+let run =
+  Alcotest_lwt.run "cstruct_append"
+    [
+      ( "cstruct_append",
+        [
+          test_simple_use; test_trunk_mode; test_two_contents;
+          test_three_contents;
+        ] );
+    ]
+
+let () = Lwt_main.run run