diff --git a/src/test-runner/entry_point.ml b/src/test-runner/entry_point.ml index d6c0e70..1dc913a 100644 --- a/src/test-runner/entry_point.ml +++ b/src/test-runner/entry_point.ml @@ -48,34 +48,45 @@ let test_timeout = mk_timeout ~names:[ "test-timeout" ] ~default:Mtime.Span.(10 * min) ~task:"running test executable" -(* TODO: timestamp formatting is ugly *) -let mk_timestamp ~default ~names ~when_ = +let mk_timestamp ~names ?doc ?absent arg = + Arg.(value & arg & info names ?doc ?absent ~docv:"TIMESTAMP") + +let timestamp_now = + let doc = + "Use the given timestamp instead of the system time to \ + decide whether to show or hide hidden and secret tests." + in + Arg.( + mk_timestamp ~names:[ "now" ] ~doc ~absent:"current time" + & opt (some float) None) + +let mk_timestamp_start_end ~when_ ~names ~default = let doc = f"%s time of the exercise (as a UNIX timestamp, in UTC). \ Determines when secret test results are hidden and shown." (String.capitalize_ascii when_) in - Arg.(value & opt float default & info names ~doc ~docv:"TIMESTAMP") + Arg.(mk_timestamp ~names ~doc ~absent:"unbounded" & opt float default) let exercise_start = - mk_timestamp ~default:(-. max_float) + mk_timestamp_start_end ~default:Float.neg_infinity ~names:[ "exercise-start" ] ~when_:"start" let exercise_end = - mk_timestamp ~default:max_float ~names:[ "exercise-end" ] ~when_:"end" - + mk_timestamp_start_end ~default:Float.infinity + ~names:[ "exercise-end" ] ~when_:"end" let term_of_runner runner = Term.( const runner $ build_root $ safe $ build_timeout $ probe_timeout - $ test_timeout $ exercise_start $ exercise_end + $ test_timeout $ timestamp_now $ exercise_start $ exercise_end ) let runner_with_cfg of_cfg build_root safe build_timeout probe_timeout - test_timeout exercise_start exercise_end = + test_timeout timestamp_now exercise_start exercise_end = { build_root; safe; build_timeout; probe_timeout; - test_timeout; exercise_start; exercise_end + timestamp_now; test_timeout; exercise_start; exercise_end } |> of_cfg diff --git a/src/test-runner/std_task.ml b/src/test-runner/std_task.ml index 496aa9a..f6a6ca7 100644 --- a/src/test-runner/std_task.ml +++ b/src/test-runner/std_task.ml @@ -35,6 +35,7 @@ type cfg = { test_timeout : Mtime.span ; probe_timeout : Mtime.span ; + timestamp_now : float option (** Override current time, UTC *); exercise_start : float (** UTC time *); exercise_end : float (** UTC time *); } @@ -61,7 +62,11 @@ let write_file_str ?label cfg s p = let configure_show_hidden cfg p = let check = task1 @@ fun _ -> - let now = Unix.gettimeofday () in + let now = + match cfg.timestamp_now with + | None -> Unix.gettimeofday () + | Some t -> t + in not cfg.safe || now < cfg.exercise_start || cfg.exercise_end < now in let write =