diff --git a/src/import.ml b/src/import.ml index 0c470215..cbd5e484 100644 --- a/src/import.ml +++ b/src/import.ml @@ -588,7 +588,5 @@ module Fmt = struct end (* This is ugly *) -type printer = - { print : 'a. ('a, Format.formatter, unit, unit) format4 -> 'a } [@@unboxed] -let printer = ref { print = fun fmt -> Format.eprintf fmt } -let print_to_console fmt = (!printer).print fmt +let printer = ref prerr_endline +let print_to_console s = !printer s diff --git a/src/loc.ml b/src/loc.ml index d11e36ff..eab028b7 100644 --- a/src/loc.ml +++ b/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@}: " ^^ fmt ^^ "@.") print t + Errors.kerrf ~f:print_to_console + ("%a@{Warning@}: " ^^ fmt ^^ "@.") print t diff --git a/src/log.ml b/src/log.ml index 15d6bd72..b89f3bf5 100644 --- a/src/log.ml +++ b/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 diff --git a/src/process.ml b/src/process.ml index 0c0c33c8..47e6ed77 100644 --- a/src/process.ml +++ b/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 diff --git a/src/report_error.ml b/src/report_error.ml index 2880265f..71e109f4 100644 --- a/src/report_error.ml +++ b/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; - flush stderr + print_to_console s end - diff --git a/src/scheduler.ml b/src/scheduler.ml index a32be798..adaa94c7 100644 --- a/src/scheduler.ml +++ b/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 = - Format.pp_print_string ppf s; - Format.pp_print_flush ppf () +let show_status_line s = + prerr_string s -let print t fmt = - let ppf = Format.err_formatter in +let print t msg = let s = t.status_line in - hide_status_line s ppf; - Format.kfprintf (show_status_line s) ppf fmt + hide_status_line s; + 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 - Format.eprintf "%t%!" (hide_status_line t.status_line) + if t.status_line <> "" then begin + 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; - show_status_line status_line ppf; + hide_status_line t.status_line; + 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) diff --git a/src/scheduler.mli b/src/scheduler.mli index a65b3e9d..4ff2ad4d 100644 --- a/src/scheduler.mli +++ b/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