Don't show "in progress" lines when not writing to a TTY

CHANGES.md

@@ -5,6 +5,8 @@
 - Fix compatibility with `fmt.0.8.8+dune` by adding a missing `fmt` dependency
   in `alcotest`'s dune file (#266, @NathanReb)
 
+- Only show "in progress" lines when writing to a TTY. (#267, @CraigFe)
+
 ### 1.2.1 (2020-07-15)
 
 - Surround pretty-printed diffs with quotes to make trailing whitespace more

src/alcotest-engine/core.ml

@@ -207,12 +207,12 @@ struct
     let log_dir = log_dir ~via_symlink:true t |> maybe_collapse_home in
     Pp.suite_results ~verbose ~show_errors ~json ~compact ~log_dir
 
-  let pp_event ~prior_error ~tests_so_far t =
+  let pp_event ~isatty ~prior_error ~tests_so_far t =
     let selector_on_failure =
       (not prior_error) && not (t.verbose || t.show_errors)
     in
     if not t.json then
-      Pp.event ~compact:t.compact ~max_label:t.max_label
+      Pp.event ~isatty ~compact:t.compact ~max_label:t.max_label
         ~doc_of_test_name:(Suite.doc_of_test_name t.suite)
         ~selector_on_failure ~tests_so_far
     else Fmt.nop
@@ -282,9 +282,12 @@ struct
   let perform_test t args { tests_so_far; prior_error } suite =
     let open Suite in
     let test = suite.fn in
-    let pp_event = pp_event t ~prior_error ~tests_so_far in
+    let print_event =
+      pp_event t ~prior_error ~tests_so_far ~isatty:(P.stdout_isatty ())
+        Fmt.stdout
+    in
     M.return () >>= fun () ->
-    pp_event Fmt.stdout (`Start suite.name);
+    print_event (`Start suite.name);
     Fmt.(flush stdout) () (* Show event before any test stderr *);
     test args >|= fun result ->
     (* Store errors *)
@@ -306,7 +309,7 @@ struct
     (* Show any remaining test output before the event *)
     Fmt.(flush stdout ());
     Fmt.(flush stderr ());
-    pp_event Fmt.stdout (`Result (suite.name, result));
+    print_event (`Result (suite.name, result));
     let state =
       { tests_so_far = tests_so_far + 1; prior_error = errored || prior_error }
     in

src/alcotest-engine/platform.ml

@@ -1,18 +1,38 @@
 module type S = sig
   val time : unit -> float
+  (** [time ()] returns the current timestamp, used to measure the duration of a
+      testrun. *)
 
   val getcwd : unit -> string
+  (** [getcwd ()] returns the current working directory. *)
 
   val prepare : base:string -> dir:string -> name:string -> unit
+  (** [prepare ~base ~dir ~name] is called before test suite execution. [base]
+      is the parent of the log directory, [dir] the log directory (including
+      unique testrun ID), and [name] is the test name. On Unix, this function
+      creates the log directory [dir] for the test output, and sets up the
+      symlink [latest] to the latest result. *)
 
   type 'a promise
+  (** The type of monadic actions handled by {!with_redirect}. *)
+
+  val stdout_isatty : unit -> bool
+  (** Return [true] if standard output refers to a terminal or console window,
+      [false] otherwise. *)
 
   val with_redirect : string -> (unit -> 'a promise) -> 'a promise
+  (** [with_redirect output_file f] is called for each test. On Unix, it it
+      deals with redirection of standard streams to the [output_file]. The
+      implementation of [with_redirect] has to make sure to call [f] in order to
+      run the test case. *)
 
   val setup_std_outputs :
     ?style_renderer:Fmt.style_renderer -> ?utf_8:bool -> unit -> unit
+  (** [setup_std_outputs ~style_renderer ~utf_8 ()] is called at startup of
+      alcotest and sets up the standard streams for colored output. *)
 
   val home_directory : unit -> (string, [ `Msg of string ]) result
+  (** [home_directory ()] is the current user's HOME directory, if it exists. *)
 end
 
 module type MAKER = functor (M : Monad.S) -> S with type 'a promise := 'a M.t

src/alcotest-engine/pp.ml

@@ -122,24 +122,25 @@ let event_line ~max_label ~doc_of_test_name ppf = function
       (info ~max_label ~doc_of_test_name) ppf p
   | _ -> assert false
 
-let event ~compact ~max_label ~doc_of_test_name ~selector_on_failure
+let event ~isatty ~compact ~max_label ~doc_of_test_name ~selector_on_failure
     ~tests_so_far ppf event =
-  match (compact, event) with
-  | true, `Start _ -> ()
-  | true, `Result (_, r) ->
-      pp_result_compact ppf r;
-      (* Wrap compact output to terminal width manually *)
-      if (tests_so_far + 1) mod terminal_width () = 0 then
-        Format.pp_force_newline ppf ();
-      ()
-  | false, `Start tname ->
+  match (compact, isatty, event) with
+  | true, _, `Start _ | _, false, `Start _ -> ()
+  | false, true, `Start tname ->
       Fmt.(
         left_padding ~with_selector:false
         ++ const (left left_c yellow_s) "..."
         ++ const (info ~max_label ~doc_of_test_name) tname)
         ppf ()
-  | false, `Result (tname, r) ->
-      Fmt.pf ppf "\r%a@,"
+  | true, _, `Result (_, r) ->
+      pp_result_compact ppf r;
+      (* Wrap compact output to terminal width manually *)
+      if (tests_so_far + 1) mod terminal_width () = 0 then
+        Format.pp_force_newline ppf ();
+      ()
+  | false, _, `Result (tname, r) ->
+      if isatty then Fmt.pf ppf "\r";
+      Fmt.pf ppf "%a@,"
         (pp_result_full ~max_label ~doc_of_test_name ~selector_on_failure)
         (tname, r)
 

src/alcotest-engine/pp.mli

@@ -41,6 +41,7 @@ val event_line :
   [ `Result of Test_name.t * [< Run_result.t ] | `Start of Test_name.t ] Fmt.t
 
 val event :
+  isatty:bool ->
   compact:bool ->
   max_label:int ->
   doc_of_test_name:(Test_name.t -> string) ->

src/alcotest-mirage/alcotest_mirage.ml

@@ -6,6 +6,8 @@ module Make (C : Mirage_clock.MCLOCK) = struct
 
     let prepare ~base:_ ~dir:_ ~name:_ = ()
 
+    let stdout_isatty () = true
+
     let with_redirect _ fn = fn ()
 
     let setup_std_outputs ?style_renderer:_ ?utf_8:_ () = ()

src/alcotest/alcotest.ml

@@ -73,6 +73,8 @@ module Unix (M : Alcotest_engine.Monad.S) = struct
     else if not (Sys.is_directory dir) then
       Fmt.failwith "exists but is not a directory: %S" dir
 
+  let stdout_isatty () = Unix.(isatty stdout)
+
   let with_redirect file fn =
     M.return () >>= fun () ->
     Fmt.(flush stdout) ();

test/e2e/alcotest-lwt/failing/async_failure.expected

@@ -1,8 +1,8 @@
 Testing `foo'.
 This run has ID `<uuid>'.
 
-  ...           all          0   one.> [FAIL]        all          0   one.
-  ...           all          1   two.  [OK]          all          1   two.
+> [FAIL]        all          0   one.
+  [OK]          all          1   two.
 
 ┌──────────────────────────────────────────────────────────────────────────────┐
 │ [FAIL]        all          0   one.                                          │

test/e2e/alcotest-lwt/failing/fail_with.expected

@@ -1,8 +1,8 @@
 Testing `foo'.
 This run has ID `<uuid>'.
 
-  ...           all          0   one.> [FAIL]        all          0   one.
-  ...           all          1   two.  [OK]          all          1   two.
+> [FAIL]        all          0   one.
+  [OK]          all          1   two.
 
 ┌──────────────────────────────────────────────────────────────────────────────┐
 │ [FAIL]        all          0   one.                                          │

test/e2e/alcotest/failing/check_basic.expected

@@ -1,32 +1,32 @@
 Testing `check_basic'.
 This run has ID `<uuid>'.
 
-  ...           different basic              0   bool.ASSERT bool
-  [FAIL]        different basic              0   bool.
-  ...           different basic              1   int.ASSERT int
-  [FAIL]        different basic              1   int.
-  ...           different basic              2   int32.ASSERT int32
-  [FAIL]        different basic              2   int32.
-  ...           different basic              3   int64.ASSERT int64
-  [FAIL]        different basic              3   int64.
-  ...           different basic              4   float.ASSERT float
-  [FAIL]        different basic              4   float.
-  ...           different basic              5   char.ASSERT char
-  [FAIL]        different basic              5   char.
-  ...           different basic              6   string.ASSERT string
-  [FAIL]        different basic              6   string.
-  ...           different basic              7   bytes.ASSERT bytes
-  [FAIL]        different basic              7   bytes.
-  ...           different composite          0   list.ASSERT list
-  [FAIL]        different composite          0   list.
-  ...           different composite          1   array.ASSERT array
-  [FAIL]        different composite          1   array.
-  ...           different composite          2   option some.ASSERT option some
-  [FAIL]        different composite          2   option some.
-  ...           different composite          3   result.ASSERT result
-  [FAIL]        different composite          3   result.
-  ...           different composite          4   pair.ASSERT pair
-  [FAIL]        different composite          4   pair.
+ASSERT bool
+  [FAIL]        different basic              0   bool.
+ASSERT int
+  [FAIL]        different basic              1   int.
+ASSERT int32
+  [FAIL]        different basic              2   int32.
+ASSERT int64
+  [FAIL]        different basic              3   int64.
+ASSERT float
+  [FAIL]        different basic              4   float.
+ASSERT char
+  [FAIL]        different basic              5   char.
+ASSERT string
+  [FAIL]        different basic              6   string.
+ASSERT bytes
+  [FAIL]        different basic              7   bytes.
+ASSERT list
+  [FAIL]        different composite          0   list.
+ASSERT array
+  [FAIL]        different composite          1   array.
+ASSERT option some
+  [FAIL]        different composite          2   option some.
+ASSERT result
+  [FAIL]        different composite          3   result.
+ASSERT pair
+  [FAIL]        different composite          4   pair.
 
 ┌──────────────────────────────────────────────────────────────────────────────┐
 │ [FAIL]        different basic              0   bool.                         │

test/e2e/alcotest/failing/check_long.expected

@@ -1,12 +1,12 @@
 Testing `check_long'.
 This run has ID `<uuid>'.
 
-  ...           wrapping          0   list.ASSERT list
-  [FAIL]        wrapping          0   list.
-  ...           wrapping          1   array.ASSERT array
-  [FAIL]        wrapping          1   array.
-  ...           wrapping          2   nested options.ASSERT nested options
-  [FAIL]        wrapping          2   nested options.
+ASSERT list
+  [FAIL]        wrapping          0   list.
+ASSERT array
+  [FAIL]        wrapping          1   array.
+ASSERT nested options
+  [FAIL]        wrapping          2   nested options.
 
 ┌──────────────────────────────────────────────────────────────────────────────┐
 │ [FAIL]        wrapping          0   list.                                    │

test/e2e/alcotest/failing/exception_in_test.expected

@@ -1,9 +1,9 @@
 Testing `suite-with-failures'.
 This run has ID `<uuid>'.
 
-  ...           test-a          0   Passing.  [OK]          test-a          0   Passing.
-  ...           test-a          1   Failing.> [FAIL]        test-a          1   Failing.
-  ...           test-b          0   Another pass.  [OK]          test-b          0   Another pass.
+  [OK]          test-a          0   Passing.
+> [FAIL]        test-a          1   Failing.
+  [OK]          test-b          0   Another pass.
 
 ┌──────────────────────────────────────────────────────────────────────────────┐
 │ [FAIL]        test-a          1   Failing.                                   │

test/e2e/alcotest/failing/invalid_arg_in_test.expected

@@ -1,9 +1,9 @@
 Testing `suite-with-failures'.
 This run has ID `<uuid>'.
 
-  ...           test-a          0   Passing.  [OK]          test-a          0   Passing.
-  ...           test-a          1   Failing.> [FAIL]        test-a          1   Failing.
-  ...           test-b          0   Another pass.  [OK]          test-b          0   Another pass.
+  [OK]          test-a          0   Passing.
+> [FAIL]        test-a          1   Failing.
+  [OK]          test-b          0   Another pass.
 
 ┌──────────────────────────────────────────────────────────────────────────────┐
 │ [FAIL]        test-a          1   Failing.                                   │

test/e2e/alcotest/failing/long_test_case_name.expected

@@ -1,8 +1,8 @@
 Testing `suite-with-failures'.
 This run has ID `<uuid>'.
 
-  ...           test-a          0   Passing.  [OK]          test-a          0   Passing.
-  ...           test-a          1   Lorem ipsum dolor sit amet, consectetur adipiscing elit. Suspendisse mollis, orci sed venenatis efficitur, eros est imperdiet purus, sit amet tincidunt massa diam ut elit.> [FAIL]        test-a          1   Lorem ipsum dolor sit amet, consectetur adipiscing elit. Suspendisse mollis, orci sed venenatis efficitur, eros est imperdiet purus, sit amet tincidunt massa diam ut elit.
+  [OK]          test-a          0   Passing.
+> [FAIL]        test-a          1   Lorem ipsum dolor sit amet, consectetur adipiscing elit. Suspendisse mollis, orci sed venenatis efficitur, eros est imperdiet purus, sit amet tincidunt massa diam ut elit.
 
 ┌───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
 │ [FAIL]        test-a          1   Lorem ipsum dolor sit amet, consectetur adipiscing elit. Suspendisse mollis, orci sed venenatis efficitur, eros est imperdiet purus, sit amet tincidunt massa diam ut elit. │

test/e2e/alcotest/failing/tail_errors_limit.expected

@@ -1,7 +1,7 @@
 Testing `tail_errors_limit'.
 This run has ID `<uuid>'.
 
-  ...           failing          0   test.> [FAIL]        failing          0   test.
+> [FAIL]        failing          0   test.
 
 ┌──────────────────────────────────────────────────────────────────────────────┐
 │ [FAIL]        failing          0   test.                                     │

test/e2e/alcotest/failing/tail_errors_unlimited.expected

@@ -1,7 +1,7 @@
 Testing `tail_errors_unlimited'.
 This run has ID `<uuid>'.
 
-  ...           failing          0   test.> [FAIL]        failing          0   test.
+> [FAIL]        failing          0   test.
 
 ┌──────────────────────────────────────────────────────────────────────────────┐
 │ [FAIL]        failing          0   test.                                     │

test/e2e/alcotest/inside-dune/color-overridden.expected

@@ -1,9 +1,9 @@
 Testing `test_color'.
 This run has ID `<uuid>'.
 
-  ...           alpha          0   Output may or may not contain ANSII escape codes.  [OK]          alpha          0   Output may or may not contain ANSII escape codes.
-  ...           alpha          1   according to whether or not [--color] is set.  [OK]          alpha          1   according to whether or not [--color] is set.
-  ...           alpha          2   (See the corresponding [dune] file.).  [OK]          alpha          2   (See the corresponding [dune] file.).
+  [OK]          alpha          0   Output may or may not contain ANSII escape codes.
+  [OK]          alpha          1   according to whether or not [--color] is set.
+  [OK]          alpha          2   (See the corresponding [dune] file.).
 
 Full test results in `<build-context>/_build/_tests/<test-dir>'.
 Test Successful in <test-duration>s. 3 tests run.

test/e2e/alcotest/passing/and_exit_false.expected

@@ -1,7 +1,7 @@
 Testing `suite-name'.
 This run has ID `<uuid>'.
 
-  ...           test-a          0   Test case.  [OK]          test-a          0   Test case.
+  [OK]          test-a          0   Test case.
 
 Full test results in `<build-context>/_build/_tests/<test-dir>'.
 Test Successful in <test-duration>s. 1 test run.

test/e2e/alcotest/passing/and_exit_true.expected

@@ -1,7 +1,7 @@
 Testing `suite-name'.
 This run has ID `<uuid>'.
 
-  ...           test-a          0   Test case.  [OK]          test-a          0   Test case.
+  [OK]          test-a          0   Test case.
 
 Full test results in `<build-context>/_build/_tests/<test-dir>'.
 Test Successful in <test-duration>s. 1 test run.