Skip to content

Commit

Permalink
fix(action): pass rev_prefix to the final union (#58)
Browse files Browse the repository at this point in the history
  • Loading branch information
@favonia
favonia committed Mar 7, 2022
1 parent 78bada6 commit 000df38
Show file tree
Hide file tree
Showing 2 changed files with 106 additions and 110 deletions.
2 changes: 1 addition & 1 deletion src/Action.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ let rec run_ ~union ~hooks ~rev_prefix pat t =
List.fold_left ~f ~init:(ret t) pats
| P_union pats ->
let+ ts = ResultMonad.map (fun pat -> run_ ~union ~hooks ~rev_prefix pat t) pats in
List.fold_left ~f:(Trie.union union) ~init:Trie.empty ts
List.fold_left ~f:(Trie.union union ~rev_prefix) ~init:Trie.empty ts
| P_hook h -> hooks h ~rev_prefix t

let run_with_hooks ?(rev_prefix=[]) ~union ~hooks = run_ ~union ~hooks ~rev_prefix
Expand Down
214 changes: 105 additions & 109 deletions test/TestAction.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,20 @@ let trie (type a) (elem : a Alcotest.testable) : a Trie.t Alcotest.testable =
end in
(module M)

let cantor ~rev_path:_ x y = if x == y then x else (x + y) * (x + y + 1) / 2 + y
type data = N of int | U of string list * data * data

let data : data Alcotest.testable =
let module M = struct
type t = data
let rec pp fmt =
function
| N i -> Format.pp_print_int fmt i
| U (rp, d1, d2) -> Format.fprintf fmt "U(%a,%a,%a)" Alcotest.(pp @@ list string) rp pp d1 pp d2
let equal = (=)
end in
(module M)

let myunion ~rev_path x y = U (rev_path, x, y)

let of_list l =
Trie.of_seq
Expand All @@ -27,187 +40,173 @@ let error : [`BindingNotFound of Pattern.path] Alcotest.testable =
let run_result elem = Alcotest.result (trie elem) error

let test_none_1 () =
Alcotest.(check @@ run_result int) "ok"
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list []))
(Action.run ~union:cantor none (of_list [["x"], 10]))
(Action.run ~union:myunion none (of_list [["x"], N 10]))

let test_none_2 () =
Alcotest.(check @@ run_result int) "ok"
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list []))
(Action.run ~union:cantor none (of_list [[], 10]))
(Action.run ~union:myunion none (of_list [[], N 10]))

let test_none_3 () =
Alcotest.(check @@ run_result int) "error"
Alcotest.(check @@ run_result data) "error"
(Error (`BindingNotFound []))
(Action.run ~union:cantor none Trie.empty)
(Action.run ~union:myunion none Trie.empty)

let test_any_1 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["x"], 10]))
(Action.run ~union:cantor any (of_list [["x"], 10]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["x"], N 10]))
(Action.run ~union:myunion any (of_list [["x"], N 10]))

let test_any_2 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [[], 10]))
(Action.run ~union:cantor any (of_list [[], 10]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [[], N 10]))
(Action.run ~union:myunion any (of_list [[], N 10]))

let test_any_3 () =
Alcotest.(check @@ run_result int) "error"
Alcotest.(check @@ run_result data) "error"
(Error (`BindingNotFound []))
(Action.run ~union:cantor any Trie.empty)
(Action.run ~union:myunion any Trie.empty)

let test_any_4 () =
let t = of_list [[], 10] in
Alcotest.(check bool) "true"
true
(Trie.equal Int.equal t @@ Result.get_ok (Action.run ~union:cantor any t))
let t = of_list [[], N 10] in
Alcotest.(check @@ run_result data) "true"
(Ok t)
(Action.run ~union:myunion any t)

let test_only_1 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["x"], 10]))
(Action.run ~union:cantor (only ["x"]) (of_list [["x"], 10; ["y"], 20]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["x"], N 10]))
(Action.run ~union:myunion (only ["x"]) (of_list [["x"], N 10; ["y"], N 20]))

let test_only_2 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["x"; "y"], 10; ["x"; "x"], 20]))
(Action.run ~union:cantor (only ["x"]) (of_list [["x"; "y"], 10; ["x"; "x"], 20; ["y"], 30]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["x"; "y"], N 10; ["x"; "x"], N 20]))
(Action.run ~union:myunion (only ["x"]) (of_list [["x"; "y"], N 10; ["x"; "x"], N 20; ["y"], N 30]))

let test_only_3 () =
Alcotest.(check @@ run_result int) "error"
Alcotest.(check @@ run_result data) "error"
(Error (`BindingNotFound ["x"]))
(Action.run ~union:cantor (only ["x"]) Trie.empty)
(Action.run ~union:myunion (only ["x"]) Trie.empty)

let test_only_4 () =
let t = of_list [["x"], 10] in
Alcotest.(check @@ run_result int) "ok"
let t = of_list [["x"], N 10] in
Alcotest.(check @@ run_result data) "ok"
(Ok t)
(Action.run ~union:cantor (only ["x"]) t)
(Action.run ~union:myunion (only ["x"]) t)

let test_except_1 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["y"], 20]))
(Action.run ~union:cantor (except ["x"]) (of_list [["x"], 10; ["y"], 20]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["y"], N 20]))
(Action.run ~union:myunion (except ["x"]) (of_list [["x"], N 10; ["y"], N 20]))

let test_except_2 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["y"], 30]))
(Action.run ~union:cantor (except ["x"]) (of_list [["x"; "y"], 10; ["x"; "x"], 20; ["y"], 30]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["y"], N 30]))
(Action.run ~union:myunion (except ["x"]) (of_list [["x"; "y"], N 10; ["x"; "x"], N 20; ["y"], N 30]))

let test_except_3 () =
Alcotest.(check @@ run_result int) "error"
Alcotest.(check @@ run_result data) "error"
(Error (`BindingNotFound ["x"]))
(Action.run ~union:cantor (except ["x"]) Trie.empty)
(Action.run ~union:myunion (except ["x"]) Trie.empty)

let test_in_1 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["x"; "z"], 10; ["y"], 20]))
(Action.run ~union:cantor (in_ ["x"] (renaming [] ["z"])) (of_list [["x"], 10; ["y"], 20]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["x"; "z"], N 10; ["y"], N 20]))
(Action.run ~union:myunion (in_ ["x"] (renaming [] ["z"])) (of_list [["x"], N 10; ["y"], N 20]))

let test_in_2 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["x"; "y"], 10; ["x"; "w"], 20; ["y"], 30]))
(Action.run ~union:cantor (in_ ["x"] (renaming ["x"] ["w"])) (of_list [["x"; "y"], 10; ["x"; "x"], 20; ["y"], 30]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["x"; "y"], N 10; ["x"; "w"], N 20; ["y"], N 30]))
(Action.run ~union:myunion (in_ ["x"] (renaming ["x"] ["w"])) (of_list [["x"; "y"], N 10; ["x"; "x"], N 20; ["y"], N 30]))

let test_in_3 () =
Alcotest.(check @@ run_result int) "error"
Alcotest.(check @@ run_result data) "error"
(Error (`BindingNotFound ["x"]))
(Action.run ~union:cantor (in_ ["x"] any) Trie.empty)
(Action.run ~union:myunion (in_ ["x"] any) Trie.empty)

let test_in_4 () =
let t = of_list [["x"; "y"], 10; ["x"; "x"], 20; ["y"], 30] in
Alcotest.(check @@ run_result int) "ok"
let t = of_list [["x"; "y"], N 10; ["x"; "x"], N 20; ["y"], N 30] in
Alcotest.(check @@ run_result data) "ok"
(Ok t)
(Action.run ~union:cantor (in_ ["x"] (renaming ["x"] ["x"])) t)
(Action.run ~union:myunion (in_ ["x"] (renaming ["x"] ["x"])) t)

let test_renaming_1 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["z"], 10; ["y"], 20]))
(Action.run ~union:cantor (renaming ["x"] ["z"]) (of_list [["x"], 10; ["y"], 20]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["z"], N 10; ["y"], N 20]))
(Action.run ~union:myunion (renaming ["x"] ["z"]) (of_list [["x"], N 10; ["y"], N 20]))

let test_renaming_2 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["z"; "y"], 10; ["z"; "x"], 20; ["y"], 30]))
(Action.run ~union:cantor (renaming ["x"] ["z"]) (of_list [["x"; "y"], 10; ["x"; "x"], 20; ["y"], 30]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["z"; "y"], N 10; ["z"; "x"], N 20; ["y"], N 30]))
(Action.run ~union:myunion (renaming ["x"] ["z"]) (of_list [["x"; "y"], N 10; ["x"; "x"], N 20; ["y"], N 30]))

let test_renaming_3 () =
Alcotest.(check @@ run_result int) "error"
Alcotest.(check @@ run_result data) "error"
(Error (`BindingNotFound ["x"]))
(Action.run ~union:cantor (renaming ["x"] ["z"]) Trie.empty)
(Action.run ~union:myunion (renaming ["x"] ["z"]) Trie.empty)

let test_renaming_4 () =
let t = of_list [["x"; "y"], 10; ["x"; "w"], 20; ["y"], 30] in
Alcotest.(check @@ run_result int) "ok"
let t = of_list [["x"; "y"], N 10; ["x"; "w"], N 20; ["y"], N 30] in
Alcotest.(check @@ run_result data) "ok"
(Ok t)
(Action.run ~union:cantor (renaming ["x"] ["x"]) t)
(Action.run ~union:myunion (renaming ["x"] ["x"]) t)

let test_renaming_5 () =
let t = of_list [["x"; "y"], 10; ["x"; "w"], 20; ["y"], 30] in
Alcotest.(check @@ run_result int) "ok"
let t = of_list [["x"; "y"], N 10; ["x"; "w"], N 20; ["y"], N 30] in
Alcotest.(check @@ run_result data) "ok"
(Ok t)
(Action.run ~union:cantor (renaming ["x"; "y"] ["x"; "y"]) t)
(Action.run ~union:myunion (renaming ["x"; "y"] ["x"; "y"]) t)

let test_seq_1 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["w"], 10; ["y"], 20]))
(Action.run ~union:cantor (seq [renaming ["x"] ["z"]; renaming ["z"] ["w"]]) (of_list [["x"], 10; ["y"], 20]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["w"], N 10; ["y"], N 20]))
(Action.run ~union:myunion (seq [renaming ["x"] ["z"]; renaming ["z"] ["w"]]) (of_list [["x"], N 10; ["y"], N 20]))

let test_seq_2 () =
Alcotest.(check @@ run_result int) "error"
Alcotest.(check @@ run_result data) "error"
(Error (`BindingNotFound []))
(Action.run ~union:cantor (seq [none; any]) (of_list [["x"; "y"], 10; ["x"; "x"], 20; ["y"], 30]))
(Action.run ~union:myunion (seq [none; any]) (of_list [["x"; "y"], N 10; ["x"; "x"], N 20; ["y"], N 30]))

let test_seq_3 () =
Alcotest.(check @@ run_result int) "error"
Alcotest.(check @@ run_result data) "error"
(Error (`BindingNotFound []))
(Action.run ~union:cantor (seq [none; none]) Trie.empty)
(Action.run ~union:myunion (seq [none; none]) Trie.empty)

let test_seq_4 () =
Alcotest.(check @@ run_result int) "error"
Alcotest.(check @@ run_result data) "error"
(Error (`BindingNotFound ["x"]))
(Action.run ~union:cantor (seq [renaming ["x"] ["z"]; only ["x"]]) (of_list [["x"], 10; ["y"], 20]))
(Action.run ~union:myunion (seq [renaming ["x"] ["z"]; only ["x"]]) (of_list [["x"], N 10; ["y"], N 20]))

let test_seq_5 () =
let t = of_list [["x"; "y"], 10; ["x"; "w"], 20; ["y"], 30] in
Alcotest.(check @@ run_result int) "ok"
let t = of_list [["x"; "y"], N 10; ["x"; "w"], N 20; ["y"], N 30] in
Alcotest.(check @@ run_result data) "ok"
(Ok t)
(Action.run ~union:cantor (seq [seq []; seq []]) t)
(Action.run ~union:myunion (seq [seq []; seq []]) t)

let test_union_1 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["x"], 10; ["y"], 20]))
(Action.run ~union:cantor (union [only ["x"]; except ["x"]]) (of_list [["x"], 10; ["y"], 20]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["x"], U (["x"], N 10, N 10); ["y"], N 20]))
(Action.run ~union:myunion (union [only ["x"]; except ["x"]; only ["x"]]) (of_list [["x"], N 10; ["y"], N 20]))

let test_union_2 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list []))
(Action.run ~union:cantor (union []) (of_list [["x"], 10; ["y"], 20]))
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list [["x"], U (["x"], N 10, N 10); ["y"], N 20]))
(Action.run ~union:myunion (in_ ["x"] (union [only []; only []])) (of_list [["x"], N 10; ["y"], N 20]))

let test_union_3 () =
let t = of_list [["x"; "y"], 10; ["x"; "w"], 20; ["y"], 30] in
Alcotest.(check @@ run_result int) "ok"
(Ok t)
(Action.run ~union:cantor (union [seq []]) t)

let test_filter_map_1 () =
Alcotest.(check @@ run_result int) "ok"
(Ok (of_list [["y"], 110]))
(Action.run_with_hooks
~hooks:(fun () ~rev_prefix t ->
Result.ok @@ Trie.filter_mapi ~rev_prefix
(fun ~rev_path:_ d -> if d > 20 then Some (d + 80) else None) t)
~union:cantor
(hook ()) (of_list [["x"; "y"], 10; ["x"; "x"], 20; ["y"], 30]))

let test_filter_map_2 () =
let t = of_list [["x"; "y"], 10; ["x"; "w"], 20; ["y"], 30] in
Alcotest.(check @@ run_result int) "ok"
Alcotest.(check @@ run_result data) "ok"
(Ok (of_list []))
(Action.run ~union:myunion (union []) (of_list [["x"], N 10; ["y"], N 20]))

let test_union_4 () =
let t = of_list [["x"; "y"], N 10; ["x"; "w"], N 20; ["y"], N 30] in
Alcotest.(check @@ run_result data) "ok"
(Ok t)
(Action.run_with_hooks
~hooks:(fun () ~rev_prefix t ->
Result.ok @@ Trie.filter_mapi ~rev_prefix
(fun ~rev_path:_ x -> Some x) t)
~union:cantor
(hook ()) t)
(Action.run ~union:myunion (union [seq []]) t)

(* FIXME: design new test cases for hooks *)

let () =
let open Alcotest in
Expand Down Expand Up @@ -258,9 +257,6 @@ let () =
test_case "union" `Quick test_union_1;
test_case "union" `Quick test_union_2;
test_case "union" `Quick test_union_3;
];
"filter_map", [
test_case "filter_map" `Quick test_filter_map_1;
test_case "filter_map" `Quick test_filter_map_2;
test_case "union" `Quick test_union_4;
];
]

0 comments on commit 000df38

Please sign in to comment.