Skip to content

Commit

Permalink
Better version of create2
Browse files Browse the repository at this point in the history
  • Loading branch information
emillon committed Jul 13, 2021
1 parent fe78b9b commit ccc328e
Showing 1 changed file with 50 additions and 47 deletions.
97 changes: 50 additions & 47 deletions test/unit/mock.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2,65 +2,68 @@ type ('a, 'b) expectation = 'a * 'b

let expect expected ~and_return:return_value = (expected, return_value)

type ('a1, 'b1, 'a2, 'b2) t = {
testable1 : 'a1 Alcotest.testable;
testable2 : 'a2 Alcotest.testable;
type ('a, 'b) t = {
testable : 'a Alcotest.testable;
loc : string;
mutable expectations :
(('a1, 'b1) expectation, ('a2, 'b2) expectation) Either.t list;
mutable expectations : ('a, 'b) expectation list;
}

let call1 t got =
let call t got =
match t.expectations with
| [] ->
Alcotest.failf "Got call at %s but no more expectations: %a" t.loc
(Alcotest.pp t.testable1) got
| Left (expected, rv) :: other_expectations ->
(Alcotest.pp t.testable) got
| (expected, rv) :: other_expectations ->
t.expectations <- other_expectations;
Alcotest.check t.testable1 t.loc expected got;
Alcotest.check t.testable t.loc expected got;
rv
| Right (expected, _) :: _ ->
Alcotest.failf "Got a call of the wrong type at %s: got %a, expected %a"
t.loc (Alcotest.pp t.testable1) got (Alcotest.pp t.testable2) expected

let call2 t got =
(* XXX dedup with call1 *)
match t.expectations with
| [] ->
Alcotest.failf "Got call at %s but no more expectations: %a" t.loc
(Alcotest.pp t.testable2) got
| Right (expected, rv) :: other_expectations ->
t.expectations <- other_expectations;
Alcotest.check t.testable2 t.loc expected got;
rv
| Left (expected, _) :: _ ->
Alcotest.failf "Got a call of the wrong type at %s: got %a, expected %a"
t.loc (Alcotest.pp t.testable2) got (Alcotest.pp t.testable1) expected

let check_empty2 t =
let check_empty t =
match t.expectations with
| [] -> ()
| Left (remaining, _) :: _ ->
Alcotest.check (Alcotest.option t.testable1) t.loc None (Some remaining)
| Right (remaining, _) :: _ ->
Alcotest.check (Alcotest.option t.testable2) t.loc None (Some remaining)

let create2 testable1 testable2 loc expectations =
let t = { testable1; testable2; loc; expectations } in
(call1 t, call2 t, fun () -> check_empty2 t)

module Void = struct
type t = |

let absurd : t -> _ = function _ -> .
| (remaining, _) :: _ ->
Alcotest.check (Alcotest.option t.testable) t.loc None (Some remaining)

let pp _ppf = absurd
let create testable loc expectations =
let t = { testable; loc; expectations } in
(call t, fun () -> check_empty t)

let equal = absurd
end
let list_partition_map l ~f =
let open Either in
let rec go acc_l acc_r = function
| [] -> (List.rev acc_l, List.rev acc_r)
| x :: xs -> (
match f x with
| Left yl -> go (yl :: acc_l) acc_r xs
| Right yr -> go acc_l (yr :: acc_r) xs)
in
go [] [] l

let create testable loc expectations =
let f, (_ : Void.t -> _), check =
create2 testable (module Void) loc (List.map Either.left expectations)
let create2 testable1 testable2 loc expectations =
let open Either in
let numbered_expectations = List.mapi (fun i e -> (i, e)) expectations in
let expectations1, expectations2 =
list_partition_map numbered_expectations ~f:(function
| i, Left (arg_l, ret_l) -> Left ((i, arg_l), ret_l)
| i, Right (arg_r, ret_r) -> Right ((i, arg_r), ret_r))
in
let call1, check1 =
create (Alcotest.pair Alcotest.int testable1) loc expectations1
in
let call2, check2 =
create (Alcotest.pair Alcotest.int testable2) loc expectations2
in
let count = ref (-1) in
let f1 x =
incr count;
call1 (!count, x)
in
let f2 x =
incr count;
call2 (!count, x)
in
let check () =
check1 ();
check2 ()
in
(f, check)
(f1, f2, check)

0 comments on commit ccc328e

Please sign in to comment.