MinaProtocol / mina / 535

Committed 25 Aug 2025 05:35PM UTC coverage: 32.09% (-28.7%) from 60.772%

Build # 535

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #17673 from MinaProtocol/amcie-merge-release320-to-master

amcie-merge-release320-to-master

Run Details

1010 of 3745 new or added lines in 242 files covered. (26.97%)

17403 existing lines in 378 files now uncovered.

23062 of 71866 relevant lines covered (32.09%)

24742.7 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

6.67

/src/lib/disk_cache/lmdb/disk_cache.ml

(* Cache proofs using the lmdb *)

open Core
open Lmdb_storage.Generic

module Make (Data : Binable.S) = struct
  module F (Db : Db) = struct
    type holder = (int, Data.t) Db.t

    let mk_maps { Db.create } =
      create Lmdb_storage.Conv.uint32_be
        (Lmdb_storage.Conv.bin_prot_conv Data.bin_t)

    let config = { default_config with initial_mmap_size = 256 lsl 20 }
  end

  module Rw = Read_write (F)

  type t =
    { env : Rw.t
    ; db : Rw.holder
    ; counter : int ref
    ; reusable_keys : int Queue.t
          (** A list of ids that are no longer reachable from OCaml runtime, but
              haven't been cleared inside the LMDB disk cache *)
    ; queue_guard : Error_checking_mutex.t
    }

  (** How big can the queue [reusable_keys] be before we do a cleanup *)
  let reuse_size_limit = 512

  let initialize path ~logger =
    Async.Deferred.Result.map (Disk_cache_utils.initialize_dir path ~logger)
      ~f:(fun path ->
        let env, db = Rw.create path in
        { env
        ; db
        ; counter = ref 0
        ; reusable_keys = Queue.create ()
        ; queue_guard = Error_checking_mutex.create ()
        } )

  type id = { idx : int }

  let get ({ env; db; _ } : t) ({ idx } : id) : Data.t =
    Rw.get ~env db idx |> Option.value_exn

  let put ({ env; db; counter; reusable_keys; queue_guard } : t) (x : Data.t) :
      id =
    let idx =
      match
        Error_checking_mutex.critical_section queue_guard ~f:(fun () ->
            Queue.dequeue reusable_keys )
      with
      | None ->
          (* We don't have reusable keys, assign a new one nobody ever used *)
          incr counter ; !counter - 1
      | Some reused_key ->
          (* Any key inside [reusable_keys] is marked as garbage by GC, so we're
             free to use them *)
          reused_key
    in
    let res = { idx } in
    (* When this reference is GC'd, delete the file. *)
    Gc.Expert.add_finalizer_last_exn res (fun () ->
        (* The actual deletion is delayed, as GC maybe triggered in LMDB's
           critical section. LMDB critical section then will be re-entered if
           it's invoked directly in a GC hook.
           This causes mutex double-acquiring and node freezes. *)
        Error_checking_mutex.critical_section queue_guard ~f:(fun () ->
            Queue.enqueue reusable_keys idx ) ) ;

    Error_checking_mutex.critical_section queue_guard ~f:(fun () ->
        if Queue.length reusable_keys >= reuse_size_limit then (
          Rw.batch_remove ~env db reusable_keys ;
          Queue.clear reusable_keys ) ) ;
    Rw.set ~env db idx x ;
    res

  let iteri ({ env; db; _ } : t) ~f = Rw.iter ~env db ~f

  let count ({ env; db; _ } : t) =
    let sum = ref 0 in
    Rw.iter ~env db ~f:(fun _ _ -> incr sum ; `Continue) ;
    !sum

  let int_of_id { idx } = idx
end

let%test_module "disk_cache lmdb" =
  ( module struct
    include Disk_cache_test_lib.Make_extended (Make)

    let%test_unit "remove data on gc" = remove_data_on_gc ~gc_strict:false ()

    let%test_unit "simple read/write (with iteration)" =
      simple_write_with_iteration ()

    let%test_unit "initialization special cases" =
      initialization_special_cases ()
  end )

1	(* Cache proofs using the lmdb *)
2		49✔
3	open Core
4	open Lmdb_storage.Generic
5
6	module Make (Data : Binable.S) = struct
7	module F (Db : Db) = struct
8	type holder = (int, Data.t) Db.t
9
10	let mk_maps { Db.create } =
UNCOV 11	create Lmdb_storage.Conv.uint32_be	×
UNCOV 12	(Lmdb_storage.Conv.bin_prot_conv Data.bin_t)	×
13
14	let config = { default_config with initial_mmap_size = 256 lsl 20 }
15	end
16
17	module Rw = Read_write (F)
18
19	type t =
20	{ env : Rw.t
21	; db : Rw.holder
22	; counter : int ref
23	; reusable_keys : int Queue.t
24	(** A list of ids that are no longer reachable from OCaml runtime, but
25	haven't been cleared inside the LMDB disk cache *)
26	; queue_guard : Error_checking_mutex.t
27	}
28
29	(** How big can the queue [reusable_keys] be before we do a cleanup *)
30	let reuse_size_limit = 512
31
32	let initialize path ~logger =
NEW 33	Async.Deferred.Result.map (Disk_cache_utils.initialize_dir path ~logger)	×
34	~f:(fun path ->
UNCOV 35	let env, db = Rw.create path in	×
NEW 36	{ env	×
37	; db
38	; counter = ref 0
NEW 39	; reusable_keys = Queue.create ()	×
NEW 40	; queue_guard = Error_checking_mutex.create ()	×
41	} )
42
43	type id = { idx : int }
44
45	let get ({ env; db; _ } : t) ({ idx } : id) : Data.t =
UNCOV 46	Rw.get ~env db idx \|> Option.value_exn	×
47
48	let put ({ env; db; counter; reusable_keys; queue_guard } : t) (x : Data.t) :
49	id =
NEW 50	let idx =	×
51	match
52	Error_checking_mutex.critical_section queue_guard ~f:(fun () ->
NEW 53	Queue.dequeue reusable_keys )	×
54	with
NEW 55	\| None ->	×
56	(* We don't have reusable keys, assign a new one nobody ever used *)
NEW 57	incr counter ; !counter - 1	×
NEW 58	\| Some reused_key ->	×
59	(* Any key inside [reusable_keys] is marked as garbage by GC, so we're
60	free to use them *)
61	reused_key
62	in
63	let res = { idx } in
64	(* When this reference is GC'd, delete the file. *)
65	Gc.Expert.add_finalizer_last_exn res (fun () ->
66	(* The actual deletion is delayed, as GC maybe triggered in LMDB's
67	critical section. LMDB critical section then will be re-entered if
68	it's invoked directly in a GC hook.
69	This causes mutex double-acquiring and node freezes. *)
NEW 70	Error_checking_mutex.critical_section queue_guard ~f:(fun () ->	×
NEW 71	Queue.enqueue reusable_keys idx ) ) ;	×
72
NEW 73	Error_checking_mutex.critical_section queue_guard ~f:(fun () ->	×
NEW 74	if Queue.length reusable_keys >= reuse_size_limit then (	×
75	Rw.batch_remove ~env db reusable_keys ;
NEW 76	Queue.clear reusable_keys ) ) ;	×
UNCOV 77	Rw.set ~env db idx x ;	×
UNCOV 78	res	×
79
UNCOV 80	let iteri ({ env; db; _ } : t) ~f = Rw.iter ~env db ~f	×
81
82	let count ({ env; db; _ } : t) =
UNCOV 83	let sum = ref 0 in	×
UNCOV 84	Rw.iter ~env db ~f:(fun _ _ -> incr sum ; `Continue) ;	×
UNCOV 85	!sum	×
86
UNCOV 87	let int_of_id { idx } = idx	×
88	end
89
90	let%test_module "disk_cache lmdb" =
91	( module struct
92	include Disk_cache_test_lib.Make_extended (Make)
93
NEW 94	let%test_unit "remove data on gc" = remove_data_on_gc ~gc_strict:false ()	×
95
96	let%test_unit "simple read/write (with iteration)" =
UNCOV 97	simple_write_with_iteration ()	×
98
99	let%test_unit "initialization special cases" =
UNCOV 100	initialization_special_cases ()	×
101	end )	98✔

MinaProtocol / mina / 535

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous