MinaProtocol / mina / 411

Committed 24 Jul 2025 03:14PM UTC coverage: 33.188% (-27.7%) from 60.871%

Build # 411

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #17541 from MinaProtocol/brian/merge-compatible-into-develop

Merge compatible into develop

Coverage Stats

164 of 702 new or added lines in 96 files covered. (23.36%)

18243 existing lines in 393 files now uncovered.

23983 of 72264 relevant lines covered (33.19%)

24667.26 hits per line

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

2.86

/src/lib/testing/integration_test_lib/malleable_error.ml

open Core_kernel
open Async_kernel

(** The is a monad which is conceptually similar to `Deferred.Or_error.t`,
 *  except that there are 2 types of errors which can be returned at each bind
 *  point in a computation: soft errors, and hard errors. Soft errors do not
 *  effect the control flow of the monad, and are instead accumulated for later
 *  extraction. Hard errors effect the control flow of the monad in the same
 *  way an `Error` constructor for `Or_error.t` would.
 It remains similar to Deferred.Or_error.t in that it is a specialization of Deferred.Result.t
 *)

module Error_accumulator = Test_error.Error_accumulator

module Hard_fail = struct
  type t =
    { (* Most of the time, there is only one hard error, but we can have multiple when joining lists of monads (concurrency) *)
      hard_errors : Test_error.internal_error Error_accumulator.t
    ; soft_errors : Test_error.internal_error Error_accumulator.t
    ; exit_code : int option
    }
  [@@deriving equal, sexp_of, compare]

  (* INVARIANT: hard_errors should always have at least 1 error *)
  let check_invariants { hard_errors; _ } =
    Error_accumulator.error_count hard_errors > 0

  let add_soft_errors { hard_errors; soft_errors; exit_code } new_soft_errors =
    { hard_errors
    ; soft_errors = Error_accumulator.merge soft_errors new_soft_errors
    ; exit_code
    }

  let of_hard_errors ?exit_code hard_errors =
    { hard_errors; soft_errors = Error_accumulator.empty; exit_code }

  let contextualize context { hard_errors; soft_errors; exit_code } =
    { hard_errors =
        Error_accumulator.contextualize' context hard_errors
          ~time_of_error:Test_error.occurrence_time
    ; soft_errors =
        Error_accumulator.contextualize' context soft_errors
          ~time_of_error:Test_error.occurrence_time
    ; exit_code
    }
end

module Result_accumulator = struct
  type 'a t =
    { computation_result : 'a
    ; soft_errors : Test_error.internal_error Error_accumulator.t
    }
  [@@deriving equal, sexp_of, compare]

  let create computation_result soft_errors =
    { computation_result; soft_errors }

  let return a =
    { computation_result = a; soft_errors = Error_accumulator.empty }

  let is_ok { soft_errors; _ } = Error_accumulator.error_count soft_errors = 0

  let contextualize context acc =
    { acc with
      soft_errors =
        Error_accumulator.contextualize' context acc.soft_errors
          ~time_of_error:Test_error.occurrence_time
    }
end

type 'a t = ('a Result_accumulator.t, Hard_fail.t) Deferred.Result.t

module T = Monad.Make (struct
  type nonrec 'a t = 'a t

  let return a =
    a |> Result_accumulator.return |> Result.return |> Deferred.return

  let bind res ~f =
    let open Result_accumulator in
    match%bind res with
    | Ok { computation_result = prev_result; soft_errors } -> (
        match%map f prev_result with
        | Ok { computation_result; soft_errors = new_soft_errors } ->
            Ok
              { computation_result
              ; soft_errors =
                  Error_accumulator.merge soft_errors new_soft_errors
              }
        | Error hard_fail ->
            Error (Hard_fail.add_soft_errors hard_fail soft_errors) )
    | Error hard_fail ->
        if not (Hard_fail.check_invariants hard_fail) then
          failwith
            "Malleable_error invariant broken: got a hard fail without an error"
        else Deferred.return (Error hard_fail)

  let map = `Define_using_bind
end)

include T

let lift = Deferred.bind ~f:return

let soft_error ~value error =
  error |> Test_error.internal_error |> Error_accumulator.singleton
  |> Result_accumulator.create value
  |> Result.return |> Deferred.return

let hard_error ?exit_code error =
  error |> Test_error.internal_error |> Error_accumulator.singleton
  |> Hard_fail.of_hard_errors ?exit_code
  |> Result.fail |> Deferred.return

let contextualize context m =
  let open Deferred.Let_syntax in
  match%map m with
  | Ok acc ->
      Ok (Result_accumulator.contextualize context acc)
  | Error hard_fail ->
      Error (Hard_fail.contextualize context hard_fail)

let soften_error m =
  let open Deferred.Let_syntax in
  match%map m with
  | Ok acc ->
      Ok acc
  | Error { Hard_fail.soft_errors; hard_errors; exit_code = _ } ->
      Ok
        (Result_accumulator.create ()
           (Error_accumulator.merge soft_errors hard_errors) )

let is_ok = function Ok acc -> Result_accumulator.is_ok acc | _ -> false

let ok_unit = return ()

let ok_if_true ?(error_type = `Hard) ~error b =
  if b then Result_accumulator.return () |> Result.return |> Deferred.return
  else
    match error_type with
    | `Soft ->
        soft_error ~value:() error
    | `Hard ->
        hard_error error

let or_soft_error ~value or_error =
  match or_error with
  | Ok x ->
      return x
  | Error error ->
      soft_error ~value error

let soft_error_string ~value = Fn.compose (soft_error ~value) Error.of_string

let soft_error_format ~value format =
  Printf.ksprintf (soft_error_string ~value) format

let or_hard_error ?exit_code or_error =
  match or_error with
  | Ok x ->
      return x
  | Error error ->
      hard_error ?exit_code error

let hard_error_string ?exit_code =
  Fn.compose (hard_error ?exit_code) Error.of_string

let hard_error_format ?exit_code format =
  Printf.ksprintf (hard_error_string ?exit_code) format

let combine_errors (malleable_errors : 'a t list) : 'a list t =
  let open T.Let_syntax in
  let%map values =
    List.fold_left malleable_errors ~init:(return []) ~f:(fun acc el ->
        let%bind t = acc in
        let%map h = el in
        h :: t )
  in
  List.rev values

let lift_error_set (type a) (m : a t) :
    ( a * Test_error.internal_error Test_error.Set.t
    , Test_error.internal_error Test_error.Set.t )
    Deferred.Result.t =
  let open Deferred.Let_syntax in
  let error_set ?exit_code hard_errors soft_errors =
    { Test_error.Set.hard_errors; soft_errors; exit_code }
  in
  match%map m with
  | Ok { computation_result; soft_errors } ->
      Ok (computation_result, error_set Error_accumulator.empty soft_errors)
  | Error { hard_errors; soft_errors; exit_code } ->
      Error (error_set ?exit_code hard_errors soft_errors)

let lift_error_set_unit (m : unit t) :
    Test_error.internal_error Test_error.Set.t Deferred.t =
  let open Deferred.Let_syntax in
  match%map lift_error_set m with
  | Ok ((), errors) ->
      errors
  | Error errors ->
      errors

module List = struct
  let rec iter ls ~f =
    let open T.Let_syntax in
    match ls with
    | [] ->
        return ()
    | h :: t ->
        let%bind () = f h in
        iter t ~f

  let rec map ls ~f =
    let open T.Let_syntax in
    match ls with
    | [] ->
        return []
    | h :: t ->
        let%bind h' = f h in
        let%map t' = map t ~f in
        h' :: t'

  let mapi ls ~f =
    let open T.Let_syntax in
    let rec go i ~f = function
      | [] ->
          return []
      | h :: t ->
          let%bind h' = f i h in
          let%map t' = go (i + 1) t ~f in
          h' :: t'
    in
    go 0 ~f ls

  let rec fold ls ~init ~f =
    let open T.Let_syntax in
    match ls with
    | [] ->
        return init
    | h :: t ->
        let%bind init' = f init h in
        fold t ~init:init' ~f

  let rec fold_left_while ls ~init ~f =
    let open T.Let_syntax in
    match ls with
    | [] ->
        return init
    | h :: t -> (
        match%bind f init h with
        | `Stop init' ->
            return init'
        | `Continue init' ->
            fold_left_while t ~init:init' ~f )

  let iteri ls ~f =
    let open T.Let_syntax in
    let%map _ =
      fold ls ~init:0 ~f:(fun i x ->
          let%map () = f i x in
          i + 1 )
    in
    ()

  let for_all ls ~f =
    let open T.Let_syntax in
    fold ls ~init:true ~f:(fun acc x -> if acc then f x else return false)
end

let%test_module "malleable error unit tests" =
  ( module struct
    (* we derive custom equality and comparisions for our result type, as the
       * default behavior of ppx_assert is to use polymorphic equality and comparisons
       * for results (as to why, I have no clue) *)
    type 'a inner = ('a Result_accumulator.t, Hard_fail.t) Result.t
    [@@deriving sexp_of]

    let equal_inner equal a b =
      match (a, b) with
      | Ok a', Ok b' ->
          Result_accumulator.equal equal a' b'
      | Error a', Error b' ->
          Hard_fail.equal a' b'
      | _ ->
          false

    let compare_inner compare a b =
      match (a, b) with
      | Ok a', Ok b' ->
          Result_accumulator.compare compare a' b'
      | Error a', Error b' ->
          Hard_fail.compare a' b'
      | Ok _, Error _ ->
          -1
      | Error _, Ok _ ->
          1

    let%test_unit "malleable error test 1: completes int computation when no \
                   errors" =
      Async.Thread_safe.block_on_async_exn (fun () ->
          let open Deferred.Let_syntax in
          let%bind actual =
            let open T.Let_syntax in
            let f nm =
              let%bind n = nm in
              return (n + 1)
            in
            f (f (f (f (f (return 0)))))
          in
          let%map expected = T.return 5 in
          [%test_eq: int inner] ~equal:(equal_inner Int.equal) actual expected )

    let%test_unit "malleable error test 2: completes string computation when \
                   no errors" =
      Async.Thread_safe.block_on_async_exn (fun () ->
          let open Deferred.Let_syntax in
          let%bind actual =
            let open T.Let_syntax in
            let%bind () = return () in
            return "123"
          in
          let%map expected = T.return "123" in
          [%test_eq: string inner] ~equal:(equal_inner String.equal) actual
            expected )

    let%test_unit "malleable error test 3: ok result that accumulates soft \
                   errors" =
      Async.Thread_safe.block_on_async_exn (fun () ->
          let open Deferred.Let_syntax in
          let%map actual =
            let open T.Let_syntax in
            let%bind () = soft_error ~value:() (Error.of_string "a") in
            soft_error ~value:"123" (Error.of_string "b")
          in
          let expected =
            let errors =
              Base.List.map [ "a"; "b" ]
                ~f:(Fn.compose Test_error.internal_error Error.of_string)
            in
            Result.return
              { Result_accumulator.computation_result = "123"
              ; soft_errors =
                  { Error_accumulator.empty with from_current_context = errors }
              }
          in
          [%test_eq: string inner] ~equal:(equal_inner String.equal) actual
            expected )

    let%test_unit "malleable error test 4: do a basic hard error" =
      Async.Thread_safe.block_on_async_exn (fun () ->
          let open Deferred.Let_syntax in
          let%map actual =
            let open T.Let_syntax in
            let%bind () = return () in
            hard_error (Error.of_string "xyz")
          in
          let expected =
            Result.fail
              { Hard_fail.hard_errors =
                  Error_accumulator.singleton
                    (Test_error.internal_error (Error.of_string "xyz"))
              ; soft_errors = Error_accumulator.empty
              ; exit_code = None
              }
          in
          [%test_eq: string inner] ~equal:(equal_inner String.equal) actual
            expected )

    let%test_unit "malleable error test 5: hard error that accumulates a soft \
                   error" =
      Async.Thread_safe.block_on_async_exn (fun () ->
          let open Deferred.Let_syntax in
          let%map actual =
            let open T.Let_syntax in
            let%bind () = soft_error ~value:() (Error.of_string "a") in
            let%bind () = hard_error (Error.of_string "xyz") in
            return "hello world"
          in
          let expected =
            Result.fail
              { Hard_fail.hard_errors =
                  Error_accumulator.singleton
                    (Test_error.internal_error (Error.of_string "xyz"))
              ; soft_errors =
                  Error_accumulator.singleton
                    (Test_error.internal_error (Error.of_string "a"))
              ; exit_code = None
              }
          in
          [%test_eq: string inner] ~equal:(equal_inner String.equal) actual
            expected )

    let%test_unit "malleable error test 6: hard error with multiple soft \
                   errors accumulating" =
      Async.Thread_safe.block_on_async_exn (fun () ->
          let open Deferred.Let_syntax in
          let%map actual =
            let open T.Let_syntax in
            let%bind () = soft_error ~value:() (Error.of_string "a") in
            let%bind () = soft_error ~value:() (Error.of_string "b") in
            hard_error (Error.of_string "xyz")
          in
          let expected =
            Result.fail
              { Hard_fail.hard_errors =
                  Error_accumulator.singleton
                    (Test_error.internal_error (Error.of_string "xyz"))
              ; soft_errors =
                  { Error_accumulator.empty with
                    from_current_context =
                      [ Test_error.internal_error (Error.of_string "b")
                      ; Test_error.internal_error (Error.of_string "a")
                      ]
                  }
              ; exit_code = None
              }
          in
          [%test_eq: string inner] ~equal:(equal_inner String.equal) actual
            expected )
  end )

1	open Core_kernel	2✔
2	open Async_kernel
3
4	(** The is a monad which is conceptually similar to `Deferred.Or_error.t`,
5	* except that there are 2 types of errors which can be returned at each bind
6	* point in a computation: soft errors, and hard errors. Soft errors do not
7	* effect the control flow of the monad, and are instead accumulated for later
8	* extraction. Hard errors effect the control flow of the monad in the same
9	* way an `Error` constructor for `Or_error.t` would.
10	It remains similar to Deferred.Or_error.t in that it is a specialization of Deferred.Result.t
11	*)
12
13	module Error_accumulator = Test_error.Error_accumulator
14
15	module Hard_fail = struct
16	type t =	×
17	{ (* Most of the time, there is only one hard error, but we can have multiple when joining lists of monads (concurrency) *)
18	hard_errors : Test_error.internal_error Error_accumulator.t	×
19	; soft_errors : Test_error.internal_error Error_accumulator.t	×
20	; exit_code : int option	×
21	}
22	[@@deriving equal, sexp_of, compare]
23
24	(* INVARIANT: hard_errors should always have at least 1 error *)
25	let check_invariants { hard_errors; _ } =
UNCOV 26	Error_accumulator.error_count hard_errors > 0	×
27
28	let add_soft_errors { hard_errors; soft_errors; exit_code } new_soft_errors =
UNCOV 29	{ hard_errors	×
UNCOV 30	; soft_errors = Error_accumulator.merge soft_errors new_soft_errors	×
31	; exit_code
32	}
33
34	let of_hard_errors ?exit_code hard_errors =
UNCOV 35	{ hard_errors; soft_errors = Error_accumulator.empty; exit_code }	×
36
37	let contextualize context { hard_errors; soft_errors; exit_code } =
38	{ hard_errors =	×
39	Error_accumulator.contextualize' context hard_errors	×
40	~time_of_error:Test_error.occurrence_time
41	; soft_errors =
42	Error_accumulator.contextualize' context soft_errors	×
43	~time_of_error:Test_error.occurrence_time
44	; exit_code
45	}
46	end
47
48	module Result_accumulator = struct
49	type 'a t =	×
50	{ computation_result : 'a	×
51	; soft_errors : Test_error.internal_error Error_accumulator.t	×
52	}
53	[@@deriving equal, sexp_of, compare]
54
55	let create computation_result soft_errors =
UNCOV 56	{ computation_result; soft_errors }	×
57
58	let return a =
59	{ computation_result = a; soft_errors = Error_accumulator.empty }	2✔
60
61	let is_ok { soft_errors; _ } = Error_accumulator.error_count soft_errors = 0	×
62
63	let contextualize context acc =
64	{ acc with	×
65	soft_errors =
66	Error_accumulator.contextualize' context acc.soft_errors	×
67	~time_of_error:Test_error.occurrence_time
68	}
69	end
70
71	type 'a t = ('a Result_accumulator.t, Hard_fail.t) Deferred.Result.t
72
73	module T = Monad.Make (struct
74	type nonrec 'a t = 'a t
75
76	let return a =
77	a \|> Result_accumulator.return \|> Result.return \|> Deferred.return	2✔
78
79	let bind res ~f =
UNCOV 80	let open Result_accumulator in	×
81	match%bind res with
UNCOV 82	\| Ok { computation_result = prev_result; soft_errors } -> (	×
UNCOV 83	match%map f prev_result with	×
UNCOV 84	\| Ok { computation_result; soft_errors = new_soft_errors } ->	×
85	Ok
86	{ computation_result
87	; soft_errors =
UNCOV 88	Error_accumulator.merge soft_errors new_soft_errors	×
89	}
UNCOV 90	\| Error hard_fail ->	×
UNCOV 91	Error (Hard_fail.add_soft_errors hard_fail soft_errors) )	×
UNCOV 92	\| Error hard_fail ->	×
UNCOV 93	if not (Hard_fail.check_invariants hard_fail) then	×
94	failwith	×
95	"Malleable_error invariant broken: got a hard fail without an error"
UNCOV 96	else Deferred.return (Error hard_fail)	×
97
98	let map = `Define_using_bind
99	end)
100
101	include T
102
103	let lift = Deferred.bind ~f:return
104
105	let soft_error ~value error =
UNCOV 106	error \|> Test_error.internal_error \|> Error_accumulator.singleton	×
UNCOV 107	\|> Result_accumulator.create value	×
UNCOV 108	\|> Result.return \|> Deferred.return	×
109
110	let hard_error ?exit_code error =
UNCOV 111	error \|> Test_error.internal_error \|> Error_accumulator.singleton	×
UNCOV 112	\|> Hard_fail.of_hard_errors ?exit_code	×
UNCOV 113	\|> Result.fail \|> Deferred.return	×
114
115	let contextualize context m =
116	let open Deferred.Let_syntax in	×
117	match%map m with
118	\| Ok acc ->	×
119	Ok (Result_accumulator.contextualize context acc)	×
120	\| Error hard_fail ->	×
121	Error (Hard_fail.contextualize context hard_fail)	×
122
123	let soften_error m =
124	let open Deferred.Let_syntax in	×
125	match%map m with
126	\| Ok acc ->	×
127	Ok acc
128	\| Error { Hard_fail.soft_errors; hard_errors; exit_code = _ } ->	×
129	Ok
130	(Result_accumulator.create ()	×
131	(Error_accumulator.merge soft_errors hard_errors) )	×
132
133	let is_ok = function Ok acc -> Result_accumulator.is_ok acc \| _ -> false	×
134
135	let ok_unit = return ()	2✔
136
137	let ok_if_true ?(error_type = `Hard) ~error b =	×
138	if b then Result_accumulator.return () \|> Result.return \|> Deferred.return	×
139	else
140	match error_type with	×
141	\| `Soft ->	×
142	soft_error ~value:() error
143	\| `Hard ->	×
144	hard_error error
145
146	let or_soft_error ~value or_error =
147	match or_error with	×
148	\| Ok x ->	×
149	return x
150	\| Error error ->	×
151	soft_error ~value error
152
153	let soft_error_string ~value = Fn.compose (soft_error ~value) Error.of_string	×
154
155	let soft_error_format ~value format =
156	Printf.ksprintf (soft_error_string ~value) format	×
157
158	let or_hard_error ?exit_code or_error =
159	match or_error with	×
160	\| Ok x ->	×
161	return x
162	\| Error error ->	×
163	hard_error ?exit_code error
164
165	let hard_error_string ?exit_code =
166	Fn.compose (hard_error ?exit_code) Error.of_string	×
167
168	let hard_error_format ?exit_code format =
169	Printf.ksprintf (hard_error_string ?exit_code) format	×
170
171	let combine_errors (malleable_errors : 'a t list) : 'a list t =
172	let open T.Let_syntax in	×
173	let%map values =
174	List.fold_left malleable_errors ~init:(return []) ~f:(fun acc el ->	×
175	let%bind t = acc in
176	let%map h = el in
177	h :: t )	×
178	in
179	List.rev values	×
180
181	let lift_error_set (type a) (m : a t) :
182	( a * Test_error.internal_error Test_error.Set.t
183	, Test_error.internal_error Test_error.Set.t )
184	Deferred.Result.t =
185	let open Deferred.Let_syntax in	×
186	let error_set ?exit_code hard_errors soft_errors =
187	{ Test_error.Set.hard_errors; soft_errors; exit_code }	×
188	in
189	match%map m with
190	\| Ok { computation_result; soft_errors } ->	×
191	Ok (computation_result, error_set Error_accumulator.empty soft_errors)	×
192	\| Error { hard_errors; soft_errors; exit_code } ->	×
193	Error (error_set ?exit_code hard_errors soft_errors)	×
194
195	let lift_error_set_unit (m : unit t) :
196	Test_error.internal_error Test_error.Set.t Deferred.t =
197	let open Deferred.Let_syntax in	×
198	match%map lift_error_set m with	×
199	\| Ok ((), errors) ->	×
200	errors
201	\| Error errors ->	×
202	errors
203
204	module List = struct
205	let rec iter ls ~f =
206	let open T.Let_syntax in	×
207	match ls with
208	\| [] ->	×
209	return ()
210	\| h :: t ->	×
211	let%bind () = f h in	×
212	iter t ~f	×
213
214	let rec map ls ~f =
215	let open T.Let_syntax in	×
216	match ls with
217	\| [] ->	×
218	return []
219	\| h :: t ->	×
220	let%bind h' = f h in	×
221	let%map t' = map t ~f in	×
222	h' :: t'	×
223
224	let mapi ls ~f =
225	let open T.Let_syntax in	×
226	let rec go i ~f = function
227	\| [] ->	×
228	return []
229	\| h :: t ->	×
230	let%bind h' = f i h in	×
231	let%map t' = go (i + 1) t ~f in	×
232	h' :: t'	×
233	in
234	go 0 ~f ls
235
236	let rec fold ls ~init ~f =
237	let open T.Let_syntax in	×
238	match ls with
239	\| [] ->	×
240	return init
241	\| h :: t ->	×
242	let%bind init' = f init h in	×
243	fold t ~init:init' ~f	×
244
245	let rec fold_left_while ls ~init ~f =
246	let open T.Let_syntax in	×
247	match ls with
248	\| [] ->	×
249	return init
250	\| h :: t -> (	×
251	match%bind f init h with	×
252	\| `Stop init' ->	×
253	return init'
254	\| `Continue init' ->	×
255	fold_left_while t ~init:init' ~f )
256
257	let iteri ls ~f =
258	let open T.Let_syntax in	×
259	let%map _ =
260	fold ls ~init:0 ~f:(fun i x ->	×
261	let%map () = f i x in	×
262	i + 1 )	×
263	in
264	()	×
265
266	let for_all ls ~f =
267	let open T.Let_syntax in	×
268	fold ls ~init:true ~f:(fun acc x -> if acc then f x else return false)	×
269	end
270
271	let%test_module "malleable error unit tests" =
272	( module struct
273	(* we derive custom equality and comparisions for our result type, as the
274	* default behavior of ppx_assert is to use polymorphic equality and comparisons
275	* for results (as to why, I have no clue) *)
276	type 'a inner = ('a Result_accumulator.t, Hard_fail.t) Result.t	×
277	[@@deriving sexp_of]
278
279	let equal_inner equal a b =
UNCOV 280	match (a, b) with	×
UNCOV 281	\| Ok a', Ok b' ->	×
282	Result_accumulator.equal equal a' b'
UNCOV 283	\| Error a', Error b' ->	×
284	Hard_fail.equal a' b'
285	\| _ ->	×
286	false
287
288	let compare_inner compare a b =
289	match (a, b) with	×
290	\| Ok a', Ok b' ->	×
291	Result_accumulator.compare compare a' b'
292	\| Error a', Error b' ->	×
293	Hard_fail.compare a' b'
294	\| Ok _, Error _ ->	×
295	-1
296	\| Error _, Ok _ ->	×
297	1
298
299	let%test_unit "malleable error test 1: completes int computation when no \
300	errors" =
UNCOV 301	Async.Thread_safe.block_on_async_exn (fun () ->	×
UNCOV 302	let open Deferred.Let_syntax in	×
303	let%bind actual =
304	let open T.Let_syntax in
305	let f nm =
306	let%bind n = nm in
UNCOV 307	return (n + 1)	×
308	in
UNCOV 309	f (f (f (f (f (return 0)))))	×
310	in
UNCOV 311	let%map expected = T.return 5 in	×
312	[%test_eq: int inner] ~equal:(equal_inner Int.equal) actual expected )	×
313
314	let%test_unit "malleable error test 2: completes string computation when \
315	no errors" =
UNCOV 316	Async.Thread_safe.block_on_async_exn (fun () ->	×
UNCOV 317	let open Deferred.Let_syntax in	×
318	let%bind actual =
319	let open T.Let_syntax in
UNCOV 320	let%bind () = return () in	×
UNCOV 321	return "123"	×
322	in
UNCOV 323	let%map expected = T.return "123" in	×
324	[%test_eq: string inner] ~equal:(equal_inner String.equal) actual	×
325	expected )
326
327	let%test_unit "malleable error test 3: ok result that accumulates soft \
328	errors" =
UNCOV 329	Async.Thread_safe.block_on_async_exn (fun () ->	×
UNCOV 330	let open Deferred.Let_syntax in	×
331	let%map actual =
332	let open T.Let_syntax in
UNCOV 333	let%bind () = soft_error ~value:() (Error.of_string "a") in	×
UNCOV 334	soft_error ~value:"123" (Error.of_string "b")	×
335	in
UNCOV 336	let expected =	×
337	let errors =
338	Base.List.map [ "a"; "b" ]
UNCOV 339	~f:(Fn.compose Test_error.internal_error Error.of_string)	×
340	in
UNCOV 341	Result.return	×
342	{ Result_accumulator.computation_result = "123"
343	; soft_errors =
344	{ Error_accumulator.empty with from_current_context = errors }
345	}
346	in
347	[%test_eq: string inner] ~equal:(equal_inner String.equal) actual	×
348	expected )
349
350	let%test_unit "malleable error test 4: do a basic hard error" =
UNCOV 351	Async.Thread_safe.block_on_async_exn (fun () ->	×
UNCOV 352	let open Deferred.Let_syntax in	×
353	let%map actual =
354	let open T.Let_syntax in
UNCOV 355	let%bind () = return () in	×
UNCOV 356	hard_error (Error.of_string "xyz")	×
357	in
UNCOV 358	let expected =	×
359	Result.fail
360	{ Hard_fail.hard_errors =
UNCOV 361	Error_accumulator.singleton	×
UNCOV 362	(Test_error.internal_error (Error.of_string "xyz"))	×
363	; soft_errors = Error_accumulator.empty
364	; exit_code = None
365	}
366	in
367	[%test_eq: string inner] ~equal:(equal_inner String.equal) actual	×
368	expected )
369
370	let%test_unit "malleable error test 5: hard error that accumulates a soft \
371	error" =
UNCOV 372	Async.Thread_safe.block_on_async_exn (fun () ->	×
UNCOV 373	let open Deferred.Let_syntax in	×
374	let%map actual =
375	let open T.Let_syntax in
UNCOV 376	let%bind () = soft_error ~value:() (Error.of_string "a") in	×
UNCOV 377	let%bind () = hard_error (Error.of_string "xyz") in	×
378	return "hello world"	×
379	in
UNCOV 380	let expected =	×
381	Result.fail
382	{ Hard_fail.hard_errors =
UNCOV 383	Error_accumulator.singleton	×
UNCOV 384	(Test_error.internal_error (Error.of_string "xyz"))	×
385	; soft_errors =
UNCOV 386	Error_accumulator.singleton	×
UNCOV 387	(Test_error.internal_error (Error.of_string "a"))	×
388	; exit_code = None
389	}
390	in
391	[%test_eq: string inner] ~equal:(equal_inner String.equal) actual	×
392	expected )
393
394	let%test_unit "malleable error test 6: hard error with multiple soft \
395	errors accumulating" =
UNCOV 396	Async.Thread_safe.block_on_async_exn (fun () ->	×
UNCOV 397	let open Deferred.Let_syntax in	×
398	let%map actual =
399	let open T.Let_syntax in
UNCOV 400	let%bind () = soft_error ~value:() (Error.of_string "a") in	×
UNCOV 401	let%bind () = soft_error ~value:() (Error.of_string "b") in	×
UNCOV 402	hard_error (Error.of_string "xyz")	×
403	in
UNCOV 404	let expected =	×
405	Result.fail
406	{ Hard_fail.hard_errors =
UNCOV 407	Error_accumulator.singleton	×
UNCOV 408	(Test_error.internal_error (Error.of_string "xyz"))	×
409	; soft_errors =
410	{ Error_accumulator.empty with
411	from_current_context =
UNCOV 412	[ Test_error.internal_error (Error.of_string "b")	×
UNCOV 413	; Test_error.internal_error (Error.of_string "a")	×
414	]
415	}
416	; exit_code = None
417	}
418	in
419	[%test_eq: string inner] ~equal:(equal_inner String.equal) actual	×
420	expected )
421	end )	2✔

MinaProtocol / mina / 411

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