diff --git a/test/test.cppo.ml b/test/test.cppo.ml index e6fb5c816..130589a81 100644 --- a/test/test.cppo.ml +++ b/test/test.cppo.ml @@ -408,19 +408,21 @@ end = struct end -module List = struct - include List - - let filter_map f = - let rec aux accu = function - | [] -> rev accu - | x :: l -> - match f x with - | None -> aux accu l - | Some v -> aux (v :: accu) l - in - aux [] -end +let fold_left_map f accu l = + let rec aux accu l_accu = function + | [] -> accu, List.rev l_accu + | x :: l -> + let accu, x = f accu x in + aux accu (x :: l_accu) l in + aux accu [] l + +let fold_left_mapi f accu l = + let rec aux i accu l_accu = function + | [] -> accu, List.rev l_accu + | x :: l -> + let accu, x = f i accu x in + aux (i + 1) accu (x :: l_accu) l in + aux 0 accu [] l open Lwt.Infix @@ -429,6 +431,7 @@ type suite = { suite_name : string; suite_tests : unit Alcotest_lwt.test_case list; skip_suite_if_this_is_false : unit -> bool; + skip_indexes : int list; } let suite name ?(only_if = fun () -> true) tests = @@ -443,25 +446,37 @@ let suite name ?(only_if = fun () -> true) tests = let b = run () in Alcotest.(check bool) "success" b true) in - let tests = - List.filter_map (fun test -> - if test.skip_if_this_is_false () then - Some (to_test_case test) - else None) - tests + let skip_indexes, tests = + fold_left_mapi (fun i skip_indexes test -> + if test.skip_if_this_is_false () then skip_indexes, to_test_case test + else i :: skip_indexes, to_test_case test) + [] (tests : test list) in {suite_name = name; suite_tests = tests; - skip_suite_if_this_is_false = only_if} + skip_suite_if_this_is_false = only_if; + skip_indexes} let run library_name suites = - let tests = - List.filter_map (fun suite -> + let skip = Hashtbl.create 16 in + let skip_names, tests = + fold_left_map (fun skip_names suite -> if suite.skip_suite_if_this_is_false () then - Some (suite.suite_name, suite.suite_tests) - else None) - suites in - Alcotest_lwt.run library_name tests + begin + Hashtbl.add skip suite.suite_name suite.skip_indexes; + skip_names, (suite.suite_name, suite.suite_tests) + end + else + suite.suite_name :: skip_names, (suite.suite_name, suite.suite_tests)) + [] suites in + let filter ~name ~index = + if List.mem name skip_names then `Skip + else + let skip_indexes = Hashtbl.find skip name in + if List.mem index skip_indexes then `Skip + else `Run + in + Alcotest_lwt.run ~filter library_name tests let run library_name suites = Lwt_main.run @@ run library_name suites let concurrent = run