diff --git a/lib/OSnap.ml b/lib/OSnap.ml index 94696d2..f2faf86 100644 --- a/lib/OSnap.ml +++ b/lib/OSnap.ml @@ -20,9 +20,9 @@ let setup ~sw ~env ~noCreate ~noOnly ~noSkip ~config_path = let*? all_tests = Config.Test.init config in let*? only_tests, tests = all_tests - |> ResultList.map_p_until_first_error (fun test -> + |> ResultList.traverse (fun test -> test.sizes - |> ResultList.map_p_until_first_error (fun size -> + |> ResultList.traverse (fun size -> let { name = _size_name; width; height } = size in let filename = Test.get_filename test.name width height in let current_image_path = Eio.Path.(snapshot_dir / filename) in @@ -70,39 +70,62 @@ let setup ~sw ~env ~noCreate ~noOnly ~noSkip ~config_path = let teardown t = Browser.Launcher.shutdown t.browser let run ~env t = - let ( let*? ) = Result.bind in + Eio.Switch.run + @@ fun sw -> let open Config.Types in let { tests_to_run; config; start_time; browser } = t in - let parallelism = Domain.recommended_domain_count () * 3 in - let pool = + Test.Printer.Progress.set_total (List.length tests_to_run); + let domain_count = Domain.recommended_domain_count () in + let parallelism = domain_count * 3 in + let test_stream = Eio.Stream.create 0 in + let browser_pool = Eio.Pool.create - ~validate:(fun target -> Result.is_ok target) parallelism (fun () -> Browser.Target.make browser) + ~validate:(fun target -> Result.is_ok target) + in + for _ = 1 to parallelism do + Eio.Fiber.fork_daemon ~sw (fun () -> + let rec aux () = + let request, reply = Eio.Stream.take test_stream in + let test_result = + Eio.Pool.use browser_pool (fun target -> + Test.run ~env config (Result.get_ok target) request) + in + Eio.Promise.resolve reply test_result; + aux () + in + aux ()) + done; + let rec run_test test = + let reply, resolve_reply = Eio.Promise.create () in + Eio.Stream.add test_stream (test, resolve_reply); + let response = Eio.Promise.await reply in + match response with + | Ok ({ result = Some (`Retry _); _ } as test) -> run_test test + | r -> r in - Test.Printer.Progress.set_total (List.length tests_to_run); let*? test_results = tests_to_run - |> ResultList.map_p_until_first_error (fun test -> - Eio.Pool.use pool (fun target -> - let test, { name = size_name; width; height }, exists = test in - let test = - Test.Types. - { exists - ; size_name - ; width - ; height - ; skip = test.OSnap_Config.Types.skip - ; url = test.OSnap_Config.Types.url - ; name = test.OSnap_Config.Types.name - ; actions = test.OSnap_Config.Types.actions - ; ignore_regions = test.OSnap_Config.Types.ignore - ; threshold = test.OSnap_Config.Types.threshold - ; warnings = [] - ; result = None - } - in - Test.run ~env config (Result.get_ok target) test)) + |> ResultList.traverse + @@ fun target -> + let test, { name = size_name; width; height }, exists = target in + run_test + Test.Types. + { exists + ; size_name + ; width + ; height + ; skip = test.OSnap_Config.Types.skip + ; url = test.OSnap_Config.Types.url + ; name = test.OSnap_Config.Types.name + ; actions = test.OSnap_Config.Types.actions + ; ignore_regions = test.OSnap_Config.Types.ignore + ; threshold = test.OSnap_Config.Types.threshold + ; retry = test.OSnap_Config.Types.retry + ; warnings = [] + ; result = None + } in let end_time = Unix.gettimeofday () in let seconds = end_time -. start_time in diff --git a/lib/OSnap_Config/OSnap_Config_Global.ml b/lib/OSnap_Config/OSnap_Config_Global.ml index 2805241..ce18e2c 100644 --- a/lib/OSnap_Config/OSnap_Config_Global.ml +++ b/lib/OSnap_Config/OSnap_Config_Global.ml @@ -22,6 +22,11 @@ module YAML = struct |> OSnap_Config_Utils.YAML.get_int_option ~path "threshold" |> Result.map (Option.value ~default:0) in + let* retry = + yaml + |> OSnap_Config_Utils.YAML.get_int_option ~path "retry" + |> Result.map (Option.value ~default:1) + in let* ignore_patterns = yaml |> OSnap_Config_Utils.YAML.get_string_list_option ~path "ignorePatterns" @@ -135,6 +140,7 @@ module YAML = struct Result.ok { root_path ; threshold + ; retry ; test_pattern ; ignore_patterns ; base_url @@ -186,6 +192,17 @@ module JSON = struct | Yojson.Basic.Util.Type_error (message, _) -> Result.error (`OSnap_Config_Parse_Error (message, path)) in + let* retry = + try + json + |> Yojson.Basic.Util.member "retry" + |> Yojson.Basic.Util.to_int_option + |> Option.value ~default:1 + |> Result.ok + with + | Yojson.Basic.Util.Type_error (message, _) -> + Result.error (`OSnap_Config_Parse_Error (message, path)) + in let* default_sizes = try json @@ -308,6 +325,7 @@ module JSON = struct Result.ok { root_path ; threshold + ; retry ; test_pattern ; ignore_patterns ; base_url diff --git a/lib/OSnap_Config/OSnap_Config_Test.ml b/lib/OSnap_Config/OSnap_Config_Test.ml index c7ec2a2..0785d95 100644 --- a/lib/OSnap_Config/OSnap_Config_Test.ml +++ b/lib/OSnap_Config/OSnap_Config_Test.ml @@ -138,6 +138,17 @@ module JSON = struct | Yojson.Basic.Util.Type_error (message, _) -> Result.error (`OSnap_Config_Parse_Error (message, path)) in + let* retry = + try + test + |> Yojson.Basic.Util.member "retry" + |> Yojson.Basic.Util.to_int_option + |> Option.value ~default:global_config.retry + |> Result.ok + with + | Yojson.Basic.Util.Type_error (message, _) -> + Result.error (`OSnap_Config_Parse_Error (message, path)) + in let* url = try test |> Yojson.Basic.Util.member "url" |> Yojson.Basic.Util.to_string |> Result.ok @@ -176,7 +187,7 @@ module JSON = struct | _ -> Result.ok [] in let* () = Common.collect_duplicates sizes in - Result.ok { only; skip; threshold; name; url; sizes; actions; ignore } + Result.ok { only; skip; threshold; retry; name; url; sizes; actions; ignore } ;; let parse global_config path = @@ -226,6 +237,11 @@ module YAML = struct |> OSnap_Config_Utils.YAML.get_int_option ~path "threshold" |> Result.map (Option.value ~default:global_config.threshold) in + let* retry = + test + |> OSnap_Config_Utils.YAML.get_int_option ~path "retry" + |> Result.map (Option.value ~default:global_config.retry) + in let* sizes = test |> OSnap_Config_Utils.YAML.get_list_option @@ -255,7 +271,7 @@ module YAML = struct |> Result.map (Option.value ~default:[]) in let* () = Common.collect_duplicates sizes in - Result.ok { only; skip; threshold; name; url; sizes; actions; ignore } + Result.ok { only; skip; threshold; retry; name; url; sizes; actions; ignore } ;; let parse global_config path = diff --git a/lib/OSnap_Config/OSnap_Config_Types.ml b/lib/OSnap_Config/OSnap_Config_Types.ml index 89660a4..8d2b935 100644 --- a/lib/OSnap_Config/OSnap_Config_Types.ml +++ b/lib/OSnap_Config/OSnap_Config_Types.ml @@ -25,6 +25,7 @@ type test = { only : bool ; skip : bool ; threshold : int + ; retry : int ; name : string ; url : string ; sizes : size list @@ -35,6 +36,7 @@ type test = type global = { root_path : Eio.Fs.dir_ty Eio.Path.t ; threshold : int + ; retry : int ; ignore_patterns : string list ; test_pattern : string ; base_url : string diff --git a/lib/OSnap_Test/OSnap_Test.ml b/lib/OSnap_Test/OSnap_Test.ml index a4791d9..cbe8e5d 100644 --- a/lib/OSnap_Test/OSnap_Test.ml +++ b/lib/OSnap_Test/OSnap_Test.ml @@ -124,7 +124,7 @@ let get_ignore_regions ~document target size_name regions = | Error (`OSnap_Selector_Not_Found _s) -> None | Error (`OSnap_Selector_Not_Visible _s) -> None | Error (`OSnap_CDP_Protocol_Error _ as e) -> Some (Result.error e)) - |> ResultList.map_p_until_first_error Fun.id + |> ResultList.traverse Fun.id |> Result.map List.flatten ;; @@ -216,15 +216,31 @@ let run ~env (global_config : Config.Types.global) target test = let*? () = save_screenshot screenshot ~path:updated_snapshot in Result.ok (`Failed `Layout) | Error (Pixel (diffCount, diffPercentage)) -> - Printer.diff_message - ~print_head:true - ~name:test.name - ~width:test.width - ~height:test.height - ~diffCount - ~diffPercentage; - let*? () = save_screenshot screenshot ~path:updated_snapshot in - Result.ok (`Failed (`Pixel (diffCount, diffPercentage))) + (match test.result with + | None -> + Printer.retry_message + ~count:1 + ~name:test.name + ~width:test.width + ~height:test.height; + Result.ok (`Retry 1) + | Some (`Retry i) when i < test.retry -> + Printer.retry_message + ~count:(succ i) + ~name:test.name + ~width:test.width + ~height:test.height; + Result.ok (`Retry (succ i)) + | _ -> + Printer.diff_message + ~print_head:true + ~name:test.name + ~width:test.width + ~height:test.height + ~diffCount + ~diffPercentage; + let*? () = save_screenshot screenshot ~path:updated_snapshot in + Result.ok (`Failed (`Pixel (diffCount, diffPercentage)))) in { test with result = Some result } |> Result.ok) ;; diff --git a/lib/OSnap_Test/OSnap_Test_Printer.ml b/lib/OSnap_Test/OSnap_Test_Printer.ml index 25468da..43c07d7 100644 --- a/lib/OSnap_Test/OSnap_Test_Printer.ml +++ b/lib/OSnap_Test/OSnap_Test_Printer.ml @@ -22,6 +22,14 @@ module Progress = struct (Printf.sprintf "%*i / %i " progress.total_length progress.current progress.total) ;; + let none () = + Fmt.str_like + Fmt.stdout + "%a" + (styled `Faint string) + (Printf.sprintf "%*s / %i " progress.total_length "-" progress.total) + ;; + let set_total i = Mutex.lock progress_mutex; progress.total <- i; @@ -52,11 +60,22 @@ let skipped_message ~name ~width ~height = Fmt.pr "%s %a %s @." (Progress.get_and_incr ()) - (styled `Bold (styled `Yellow string)) + (styled `Bold (styled `Magenta string)) "SKIP" (test_name ~name ~width ~height) ;; +let retry_message ~count ~name ~width ~height = + Fmt.pr + "%s %a %s %a @." + (Progress.none ()) + (styled `Bold (styled `Yellow string)) + "RETRY" + (test_name ~name ~width ~height) + (styled `Bold (styled `Yellow string)) + (Printf.sprintf "(%i)" count) +;; + let success_message ~name ~width ~height = Fmt.pr "%s %a %s @." diff --git a/lib/OSnap_Test/OSnap_Test_Types.ml b/lib/OSnap_Test/OSnap_Test_Types.ml index 107c70e..f1e6053 100644 --- a/lib/OSnap_Test/OSnap_Test_Types.ml +++ b/lib/OSnap_Test/OSnap_Test_Types.ml @@ -7,6 +7,7 @@ type t = ; actions : OSnap_Config.Types.action list ; ignore_regions : OSnap_Config.Types.ignoreType list ; threshold : int + ; retry : int ; exists : bool ; skip : bool ; warnings : string list @@ -15,6 +16,7 @@ type t = | `Failed of [ `Io | `Layout | `Pixel of int * float ] | `Passed | `Skipped + | `Retry of int ] option } diff --git a/lib/OSnap_Utils/OSnap_Utils.ml b/lib/OSnap_Utils/OSnap_Utils.ml index 0d9c510..2077b67 100644 --- a/lib/OSnap_Utils/OSnap_Utils.ml +++ b/lib/OSnap_Utils/OSnap_Utils.ml @@ -87,7 +87,7 @@ module List = struct end module ResultList = struct - let map_p_until_first_error (type err) (fn : 'a -> ('b, err) result) list = + let traverse (type err) (fn : 'a -> ('b, err) result) list = let exception FoundError of err in try list diff --git a/website/docs/Setup/configuration.md b/website/docs/Setup/configuration.md index ead6300..719ab21 100644 --- a/website/docs/Setup/configuration.md +++ b/website/docs/Setup/configuration.md @@ -76,6 +76,17 @@ The number of pixels allowed to be different, before the test will be marked as --- +### Retry + +- **Key**: `retry` +- **Required**: `false` +- **Type**: `int` +- **Default**: `1` + +The number of times a failed test should be retried before it is reported as failed. + +--- + ### Parallelism (DEPRECATED) - **Key**: `parallelism` diff --git a/website/docs/Tests/configuration.md b/website/docs/Tests/configuration.md index 381717a..1777cc6 100644 --- a/website/docs/Tests/configuration.md +++ b/website/docs/Tests/configuration.md @@ -69,6 +69,17 @@ The number of pixels allowed to be different, before the test will be marked as --- +### Retry + +- **Key**: `retry` +- **Required**: `false` +- **Type**: `int` +- **Default**: _Whatever is specified in the [global retry](../Setup/configuration#retry)_ + +The number of times a failed test should be retried before it is reported as failed. + +--- + ### Ignore Regions - **Key**: `ignore`