parent
7e1300ab95
commit
bd0593c11a
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue