Fix printing of errors (#513)

The status line wasn't properly cleared

src/import.ml

@@ -588,7 +588,5 @@ module Fmt = struct
 end
 
 (* This is ugly *)
-type printer =
+let printer = ref prerr_endline
-  { print : 'a. ('a, Format.formatter, unit, unit) format4 -> 'a } [@@unboxed]
+let print_to_console s = !printer s
-let printer = ref { print = fun fmt -> Format.eprintf fmt }
-let print_to_console fmt = (!printer).print fmt

src/loc.ml

@@ -59,4 +59,5 @@ let print ppf { start; stop } =
     start.pos_fname start.pos_lnum start_c stop_c
 
 let warn t fmt =
-  print_to_console ("%a@{<warning>Warning@}: " ^^ fmt ^^ "@.") print t
+  Errors.kerrf ~f:print_to_console
+    ("%a@{<warning>Warning@}: " ^^ fmt ^^ "@.") print t

src/log.ml

@@ -32,7 +32,7 @@ let info_internal { ppf; display; _ } str =
     Format.pp_print_flush ppf ()
   in
   write ppf;
-  if display = Verbose then print_to_console "%t" write
+  if display = Verbose then Format.kasprintf print_to_console "%t" write
 
 let info t str =
   match t with

src/process.ml

@@ -269,7 +269,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ?env ~purpose
     ~output:output
     ~exit_status:status;
   let _, progname, _ = Fancy.split_prog prog in
-  let print fmt = Scheduler.print scheduler fmt in
+  let print fmt = Errors.kerrf ~f:(Scheduler.print scheduler) fmt in
   match status with
   | WEXITED n when code_is_ok ok_codes n ->
     if display = Verbose then begin

src/report_error.ml

@@ -129,7 +129,5 @@ let report exn =
     let hash = Digest.string s in
     if not (String_set.mem hash !reported) then begin
       reported := String_set.add hash !reported;
-      prerr_string s;
+      print_to_console s
-      flush stderr
     end
-

src/scheduler.ml

@@ -74,19 +74,19 @@ let with_chdir t ~dir ~f =
   Sys.chdir dir;
   protectx () ~finally:(fun () -> Sys.chdir t.original_cwd) ~f
 
-let hide_status_line s ppf =
+let hide_status_line s =
   let len = String.length s in
-  if len > 0 then Format.fprintf ppf "\r%*s\r%!" len ""
+  if len > 0 then Printf.eprintf "\r%*s\r" len ""
 
-let show_status_line s ppf =
+let show_status_line s =
-  Format.pp_print_string ppf s;
+  prerr_string s
-  Format.pp_print_flush ppf ()
 
-let print t fmt =
+let print t msg =
-  let ppf = Format.err_formatter in
   let s = t.status_line in
-  hide_status_line s ppf;
+  hide_status_line s;
-  Format.kfprintf (show_status_line s) ppf fmt
+  prerr_string msg;
+  show_status_line s;
+  flush stderr
 
 let t_var : t Fiber.Var.t = Fiber.Var.create ()
 
@@ -114,19 +114,22 @@ let rec go_rec t =
   >>= fun () ->
   let count = Running_jobs.count () in
   if count = 0 then begin
-    Format.eprintf "%t%!" (hide_status_line t.status_line);
+    hide_status_line t.status_line;
+    flush stderr;
     Fiber.return ()
   end else begin
     if t.display = Progress then begin
-      let ppf = Format.err_formatter in
       match t.gen_status_line () with
       | None ->
-        if t.status_line <> "" then
+        if t.status_line <> "" then begin
-          Format.eprintf "%t%!" (hide_status_line t.status_line)
+          hide_status_line t.status_line;
+          flush stderr
+        end
       | Some status_line ->
         let status_line = sprintf "%s (jobs: %u)" status_line count in
-        hide_status_line t.status_line ppf;
+        hide_status_line t.status_line;
-        show_status_line   status_line ppf;
+        show_status_line   status_line;
+        flush stderr;
         t.status_line <- status_line;
     end;
     let job, status = Running_jobs.wait () in
@@ -157,7 +160,7 @@ let go ?(log=Log.no_log) ?(config=Config.default)
     ; waiting_for_available_job = Queue.create ()
     }
   in
-  printer := { print = fun fmt -> print t fmt };
+  printer := print t;
   let fiber =
     Fiber.Var.set t_var t
       (Fiber.with_error_handler (fun () -> fiber) ~on_error:Report_error.report)

src/scheduler.mli

@@ -33,4 +33,4 @@ val with_chdir : t -> dir:string -> f:(unit -> 'a) -> 'a
 val display : t -> Config.Display.t
 
 (** Print something to the terminal *)
-val print : t -> ('a, Format.formatter, unit, unit) format4 -> 'a
+val print : t -> string -> unit