MinaProtocol / mina / 507

Committed 19 Aug 2025 11:53PM UTC coverage: 33.38% (-28.0%) from 61.334%

Build # 507

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #17640 from MinaProtocol/georgeee/compatible-to-develop-2025-08-19

Merge `compatible` to `develop` (19 August 2025, pt. 2)

Run Details

24170 of 72408 relevant lines covered (33.38%)

24770.87 hits per line

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

2.17

/src/lib/testing/integration_test_lib/test_error.ml

open Core

type remote_error = { node_id : string; error_message : Logger.Message.t }

(* NB: equality on internal errors ignores timestamp *)
type internal_error =
  { occurrence_time : (Time.t[@sexp.opaque]); error : Error.t }
[@@deriving sexp]

let equal_internal_error { occurrence_time = _; error = err1 }
    { occurrence_time = _; error = err2 } =
  String.equal (Error.to_string_hum err1) (Error.to_string_hum err2)

let compare_internal_error { occurrence_time = _; error = err1 }
    { occurrence_time = _; error = err2 } =
  String.compare (Error.to_string_hum err1) (Error.to_string_hum err2)

let internal_error error = { occurrence_time = Time.now (); error }

let occurrence_time { occurrence_time; _ } = occurrence_time

let compare_time a b = Time.compare (occurrence_time a) (occurrence_time b)

(* currently a flat set of contexts mapped to errors, but perhaps a tree (for nested contexts) is better *)
(* TODO: consider switching to explicit context "enters/exits", recording introduction time upon entrance *)
module Error_accumulator = struct
  type 'error contextualized_errors =
    { introduction_time : Time.t; errors_by_time : 'error list Time.Map.t }
  [@@deriving equal, sexp_of, compare]

  type 'error t =
    { from_current_context : 'error list
    ; contextualized_errors : 'error contextualized_errors String.Map.t
    }
  [@@deriving equal, sexp_of, compare]

  let empty_contextualized_errors () =
    { introduction_time = Time.now (); errors_by_time = Time.Map.empty }

  let empty =
    { from_current_context = []; contextualized_errors = String.Map.empty }

  let is_empty { from_current_context; contextualized_errors } =
    List.is_empty from_current_context && Map.is_empty contextualized_errors

  let record_errors map context new_errors ~time_of_error =
    String.Map.update map context ~f:(fun errors_opt ->
        let errors =
          Option.value errors_opt ~default:(empty_contextualized_errors ())
        in
        let errors_by_time =
          List.fold new_errors ~init:errors.errors_by_time ~f:(fun acc error ->
              Time.Map.add_multi acc ~key:(time_of_error error) ~data:error )
        in
        { errors with errors_by_time } )

  let error_count { from_current_context; contextualized_errors } =
    let num_current_context = List.length from_current_context in
    let num_contextualized =
      String.Map.fold contextualized_errors ~init:0 ~f:(fun ~key:_ ~data sum ->
          Time.Map.length data.errors_by_time + sum )
    in
    num_current_context + num_contextualized

  let all_errors { from_current_context; contextualized_errors } =
    let context_errors =
      String.Map.data contextualized_errors
      |> List.bind ~f:(fun { errors_by_time; _ } ->
             Time.Map.data errors_by_time )
      |> List.concat
    in
    from_current_context @ context_errors

  let contextualize' context { from_current_context; contextualized_errors }
      ~time_of_error =
    { empty with
      contextualized_errors =
        record_errors contextualized_errors context from_current_context
          ~time_of_error
    }

  let contextualize = contextualize' ~time_of_error:occurrence_time

  let singleton x = { empty with from_current_context = [ x ] }

  let of_context_free_list ls = { empty with from_current_context = ls }

  let of_contextualized_list' context ls ~time_of_error =
    { empty with
      contextualized_errors =
        record_errors String.Map.empty context ls ~time_of_error
    }

  let of_contextualized_list =
    of_contextualized_list' ~time_of_error:occurrence_time

  let add t error =
    { t with from_current_context = error :: t.from_current_context }

  let add_to_context t context error ~time_of_error =
    { t with
      contextualized_errors =
        record_errors t.contextualized_errors context [ error ] ~time_of_error
    }

  let map { from_current_context; contextualized_errors } ~f =
    { from_current_context = List.map from_current_context ~f
    ; contextualized_errors =
        String.Map.map contextualized_errors ~f:(fun errors ->
            { errors with
              errors_by_time =
                Time.Map.map errors.errors_by_time ~f:(List.map ~f)
            } )
    }

  (* This only iterates over contextualized errors. You must check errors in the current context manually *)
  let iter_contexts { from_current_context = _; contextualized_errors } ~f =
    let contexts_by_time =
      contextualized_errors |> String.Map.to_alist
      |> List.map ~f:(fun (ctx, errors) ->
             (errors.introduction_time, (ctx, errors)) )
      |> Time.Map.of_alist_multi
    in
    let f =
      List.iter ~f:(fun (context, { errors_by_time; _ }) ->
          errors_by_time |> Time.Map.data |> List.concat |> f context )
    in
    Time.Map.iter contexts_by_time ~f

  let merge a b =
    let from_current_context =
      a.from_current_context @ b.from_current_context
    in
    let contextualized_errors =
      let merge_maps (type a key comparator_witness)
          (map_a : (key, a, comparator_witness) Map.t)
          (map_b : (key, a, comparator_witness) Map.t)
          ~(resolve_conflict : a -> a -> a) : (key, a, comparator_witness) Map.t
          =
        Map.fold map_b ~init:map_a ~f:(fun ~key ~data acc ->
            Map.update acc key ~f:(function
              | None ->
                  data
              | Some data' ->
                  resolve_conflict data' data ) )
      in
      let merge_contextualized_errors a_errors b_errors =
        { introduction_time =
            Time.min a_errors.introduction_time b_errors.introduction_time
        ; errors_by_time =
            merge_maps a_errors.errors_by_time b_errors.errors_by_time
              ~resolve_conflict:( @ )
        }
      in
      merge_maps a.contextualized_errors b.contextualized_errors
        ~resolve_conflict:merge_contextualized_errors
    in
    { from_current_context; contextualized_errors }

  let combine = List.fold ~init:empty ~f:merge

  let partition { from_current_context; contextualized_errors } ~f =
    let from_current_context_a, from_current_context_b =
      List.partition_tf from_current_context ~f
    in
    let contextualized_errors_a, contextualized_errors_b =
      let partition_map (type key a w) (cmp : (key, w) Map.comparator)
          (map : (key, a, w) Map.t) ~(f : a -> a * a) :
          (key, a, w) Map.t * (key, a, w) Map.t =
        Map.fold map
          ~init:(Map.empty cmp, Map.empty cmp)
          ~f:(fun ~key ~data (left, right) ->
            let l, r = f data in
            (Map.add_exn left ~key ~data:l, Map.add_exn right ~key ~data:r) )
      in
      partition_map
        (module String)
        contextualized_errors
        ~f:(fun ctx_errors ->
          let l, r =
            partition_map
              (module Time)
              ctx_errors.errors_by_time ~f:(List.partition_tf ~f)
          in
          ( { ctx_errors with errors_by_time = l }
          , { ctx_errors with errors_by_time = r } ) )
    in
    let a =
      { from_current_context = from_current_context_a
      ; contextualized_errors = contextualized_errors_a
      }
    in
    let b =
      { from_current_context = from_current_context_b
      ; contextualized_errors = contextualized_errors_b
      }
    in
    (a, b)
end

module Set = struct
  type nonrec 'error t =
    { soft_errors : 'error Error_accumulator.t
    ; hard_errors : 'error Error_accumulator.t
    ; exit_code : int option
    }

  let empty =
    { soft_errors = Error_accumulator.empty
    ; hard_errors = Error_accumulator.empty
    ; exit_code = None
    }

  let max_severity { soft_errors; hard_errors; exit_code = _ } =
    let num_soft = Error_accumulator.error_count soft_errors in
    let num_hard = Error_accumulator.error_count hard_errors in
    if num_hard > 0 then `Hard else if num_soft > 0 then `Soft else `None

  let all_errors { soft_errors; hard_errors; exit_code = _ } =
    Error_accumulator.merge soft_errors hard_errors

  let soft_singleton err =
    { empty with soft_errors = Error_accumulator.singleton err }

  let hard_singleton ?exit_code err =
    { empty with hard_errors = Error_accumulator.singleton err; exit_code }

  let of_soft_or_error = function
    | Ok () ->
        empty
    | Error err ->
        soft_singleton (internal_error err)

  let of_hard_or_error ?exit_code = function
    | Ok () ->
        empty
    | Error err ->
        hard_singleton ?exit_code (internal_error err)

  let add_soft err t =
    { t with soft_errors = Error_accumulator.add t.soft_errors err }

  let add_hard ?exit_code err t =
    let exit_code =
      match (t.exit_code, exit_code) with
      | Some exit_code, _ | None, Some exit_code ->
          Some exit_code
      | None, None ->
          None
    in
    { t with hard_errors = Error_accumulator.add t.soft_errors err; exit_code }

  let merge a b =
    { soft_errors = Error_accumulator.merge a.soft_errors b.soft_errors
    ; hard_errors = Error_accumulator.merge a.hard_errors b.hard_errors
    ; exit_code =
        ( match (a.exit_code, b.exit_code) with
        | Some exit_code, _ | None, Some exit_code ->
            Some exit_code
        | None, None ->
            None )
    }

  let combine = List.fold_left ~init:empty ~f:merge

  let partition { soft_errors; hard_errors; exit_code } ~f =
    let soft_errors_a, soft_errors_b =
      Error_accumulator.partition soft_errors ~f
    in
    let hard_errors_a, hard_errors_b =
      Error_accumulator.partition hard_errors ~f
    in
    let a =
      { soft_errors = soft_errors_a; hard_errors = hard_errors_a; exit_code }
    in
    let b =
      { soft_errors = soft_errors_b; hard_errors = hard_errors_b; exit_code }
    in
    (a, b)
end

1	open Core	2✔
2
3	type remote_error = { node_id : string; error_message : Logger.Message.t }
4
5	(* NB: equality on internal errors ignores timestamp *)
6	type internal_error =	×
7	{ occurrence_time : (Time.t[@sexp.opaque]); error : Error.t }	×
8	[@@deriving sexp]
9
10	let equal_internal_error { occurrence_time = _; error = err1 }
11	{ occurrence_time = _; error = err2 } =
12	String.equal (Error.to_string_hum err1) (Error.to_string_hum err2)	×
13
14	let compare_internal_error { occurrence_time = _; error = err1 }
15	{ occurrence_time = _; error = err2 } =
16	String.compare (Error.to_string_hum err1) (Error.to_string_hum err2)	×
17
18	let internal_error error = { occurrence_time = Time.now (); error }	×
19
20	let occurrence_time { occurrence_time; _ } = occurrence_time	×
21
22	let compare_time a b = Time.compare (occurrence_time a) (occurrence_time b)	×
23
24	(* currently a flat set of contexts mapped to errors, but perhaps a tree (for nested contexts) is better *)
25	(* TODO: consider switching to explicit context "enters/exits", recording introduction time upon entrance *)
26	module Error_accumulator = struct
27	type 'error contextualized_errors =	×
28	{ introduction_time : Time.t; errors_by_time : 'error list Time.Map.t }	×
29	[@@deriving equal, sexp_of, compare]
30
31	type 'error t =	×
32	{ from_current_context : 'error list	×
33	; contextualized_errors : 'error contextualized_errors String.Map.t	×
34	}
35	[@@deriving equal, sexp_of, compare]
36
37	let empty_contextualized_errors () =
38	{ introduction_time = Time.now (); errors_by_time = Time.Map.empty }	×
39
40	let empty =
41	{ from_current_context = []; contextualized_errors = String.Map.empty }
42
43	let is_empty { from_current_context; contextualized_errors } =
44	List.is_empty from_current_context && Map.is_empty contextualized_errors	×
45
46	let record_errors map context new_errors ~time_of_error =
47	String.Map.update map context ~f:(fun errors_opt ->	×
48	let errors =	×
49	Option.value errors_opt ~default:(empty_contextualized_errors ())	×
50	in
51	let errors_by_time =	×
52	List.fold new_errors ~init:errors.errors_by_time ~f:(fun acc error ->
53	Time.Map.add_multi acc ~key:(time_of_error error) ~data:error )	×
54	in
55	{ errors with errors_by_time } )	×
56
57	let error_count { from_current_context; contextualized_errors } =
58	let num_current_context = List.length from_current_context in	×
59	let num_contextualized =	×
60	String.Map.fold contextualized_errors ~init:0 ~f:(fun ~key:_ ~data sum ->
61	Time.Map.length data.errors_by_time + sum )	×
62	in
63	num_current_context + num_contextualized	×
64
65	let all_errors { from_current_context; contextualized_errors } =
66	let context_errors =	×
67	String.Map.data contextualized_errors	×
68	\|> List.bind ~f:(fun { errors_by_time; _ } ->	×
69	Time.Map.data errors_by_time )	×
70	\|> List.concat
71	in
72	from_current_context @ context_errors	×
73
74	let contextualize' context { from_current_context; contextualized_errors }
75	~time_of_error =
76	{ empty with	×
77	contextualized_errors =
78	record_errors contextualized_errors context from_current_context	×
79	~time_of_error
80	}
81
82	let contextualize = contextualize' ~time_of_error:occurrence_time
83
84	let singleton x = { empty with from_current_context = [ x ] }	×
85
86	let of_context_free_list ls = { empty with from_current_context = ls }	×
87
88	let of_contextualized_list' context ls ~time_of_error =
89	{ empty with	×
90	contextualized_errors =
91	record_errors String.Map.empty context ls ~time_of_error	×
92	}
93
94	let of_contextualized_list =
95	of_contextualized_list' ~time_of_error:occurrence_time
96
97	let add t error =
98	{ t with from_current_context = error :: t.from_current_context }	×
99
100	let add_to_context t context error ~time_of_error =
101	{ t with	×
102	contextualized_errors =
103	record_errors t.contextualized_errors context [ error ] ~time_of_error	×
104	}
105
106	let map { from_current_context; contextualized_errors } ~f =
107	{ from_current_context = List.map from_current_context ~f	×
108	; contextualized_errors =
109	String.Map.map contextualized_errors ~f:(fun errors ->	×
110	{ errors with	×
111	errors_by_time =
112	Time.Map.map errors.errors_by_time ~f:(List.map ~f)	×
113	} )
114	}
115
116	(* This only iterates over contextualized errors. You must check errors in the current context manually *)
117	let iter_contexts { from_current_context = _; contextualized_errors } ~f =
118	let contexts_by_time =	×
119	contextualized_errors \|> String.Map.to_alist	×
120	\|> List.map ~f:(fun (ctx, errors) ->	×
121	(errors.introduction_time, (ctx, errors)) )	×
122	\|> Time.Map.of_alist_multi
123	in
124	let f =	×
125	List.iter ~f:(fun (context, { errors_by_time; _ }) ->
126	errors_by_time \|> Time.Map.data \|> List.concat \|> f context )	×
127	in
128	Time.Map.iter contexts_by_time ~f
129
130	let merge a b =
131	let from_current_context =	×
132	a.from_current_context @ b.from_current_context
133	in
134	let contextualized_errors =
135	let merge_maps (type a key comparator_witness)
136	(map_a : (key, a, comparator_witness) Map.t)
137	(map_b : (key, a, comparator_witness) Map.t)
138	~(resolve_conflict : a -> a -> a) : (key, a, comparator_witness) Map.t
139	=
140	Map.fold map_b ~init:map_a ~f:(fun ~key ~data acc ->	×
141	Map.update acc key ~f:(function	×
142	\| None ->	×
143	data
144	\| Some data' ->	×
145	resolve_conflict data' data ) )
146	in
147	let merge_contextualized_errors a_errors b_errors =
148	{ introduction_time =	×
149	Time.min a_errors.introduction_time b_errors.introduction_time	×
150	; errors_by_time =
151	merge_maps a_errors.errors_by_time b_errors.errors_by_time	×
152	~resolve_conflict:( @ )
153	}
154	in
155	merge_maps a.contextualized_errors b.contextualized_errors	×
156	~resolve_conflict:merge_contextualized_errors
157	in
158	{ from_current_context; contextualized_errors }
159
160	let combine = List.fold ~init:empty ~f:merge
161
162	let partition { from_current_context; contextualized_errors } ~f =
163	let from_current_context_a, from_current_context_b =	×
164	List.partition_tf from_current_context ~f
165	in
166	let contextualized_errors_a, contextualized_errors_b =	×
167	let partition_map (type key a w) (cmp : (key, w) Map.comparator)
168	(map : (key, a, w) Map.t) ~(f : a -> a * a) :
169	(key, a, w) Map.t * (key, a, w) Map.t =
170	Map.fold map	×
171	~init:(Map.empty cmp, Map.empty cmp)	×
172	~f:(fun ~key ~data (left, right) ->
173	let l, r = f data in	×
174	(Map.add_exn left ~key ~data:l, Map.add_exn right ~key ~data:r) )	×
175	in
176	partition_map	×
177	(module String)
178	contextualized_errors
179	~f:(fun ctx_errors ->
180	let l, r =	×
181	partition_map
182	(module Time)
183	ctx_errors.errors_by_time ~f:(List.partition_tf ~f)
184	in
185	( { ctx_errors with errors_by_time = l }	×
186	, { ctx_errors with errors_by_time = r } ) )
187	in
188	let a =
189	{ from_current_context = from_current_context_a
190	; contextualized_errors = contextualized_errors_a
191	}
192	in
193	let b =
194	{ from_current_context = from_current_context_b
195	; contextualized_errors = contextualized_errors_b
196	}
197	in
198	(a, b)
199	end
200
201	module Set = struct
202	type nonrec 'error t =
203	{ soft_errors : 'error Error_accumulator.t
204	; hard_errors : 'error Error_accumulator.t
205	; exit_code : int option
206	}
207
208	let empty =
209	{ soft_errors = Error_accumulator.empty
210	; hard_errors = Error_accumulator.empty
211	; exit_code = None
212	}
213
214	let max_severity { soft_errors; hard_errors; exit_code = _ } =
215	let num_soft = Error_accumulator.error_count soft_errors in	×
216	let num_hard = Error_accumulator.error_count hard_errors in	×
217	if num_hard > 0 then `Hard else if num_soft > 0 then `Soft else `None	×
218
219	let all_errors { soft_errors; hard_errors; exit_code = _ } =
220	Error_accumulator.merge soft_errors hard_errors	×
221
222	let soft_singleton err =
223	{ empty with soft_errors = Error_accumulator.singleton err }	×
224
225	let hard_singleton ?exit_code err =
226	{ empty with hard_errors = Error_accumulator.singleton err; exit_code }	×
227
228	let of_soft_or_error = function
229	\| Ok () ->	×
230	empty
231	\| Error err ->	×
232	soft_singleton (internal_error err)	×
233
234	let of_hard_or_error ?exit_code = function
235	\| Ok () ->	×
236	empty
237	\| Error err ->	×
238	hard_singleton ?exit_code (internal_error err)	×
239
240	let add_soft err t =
241	{ t with soft_errors = Error_accumulator.add t.soft_errors err }	×
242
243	let add_hard ?exit_code err t =
244	let exit_code =	×
245	match (t.exit_code, exit_code) with
246	\| Some exit_code, _ \| None, Some exit_code ->	×
247	Some exit_code
248	\| None, None ->	×
249	None
250	in
251	{ t with hard_errors = Error_accumulator.add t.soft_errors err; exit_code }	×
252
253	let merge a b =
254	{ soft_errors = Error_accumulator.merge a.soft_errors b.soft_errors	×
255	; hard_errors = Error_accumulator.merge a.hard_errors b.hard_errors	×
256	; exit_code =
257	( match (a.exit_code, b.exit_code) with
258	\| Some exit_code, _ \| None, Some exit_code ->	×
259	Some exit_code
260	\| None, None ->	×
261	None )
262	}
263
264	let combine = List.fold_left ~init:empty ~f:merge
265
266	let partition { soft_errors; hard_errors; exit_code } ~f =
267	let soft_errors_a, soft_errors_b =	×
268	Error_accumulator.partition soft_errors ~f
269	in
270	let hard_errors_a, hard_errors_b =	×
271	Error_accumulator.partition hard_errors ~f
272	in
273	let a =	×
274	{ soft_errors = soft_errors_a; hard_errors = hard_errors_a; exit_code }
275	in
276	let b =
277	{ soft_errors = soft_errors_b; hard_errors = hard_errors_b; exit_code }
278	in
279	(a, b)
280	end	2✔

MinaProtocol / mina / 507

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