Skip tests using only_if and Alcotest filter

Author: MisterDA

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