From 059ae6b8f95a1af05261116c129a16b7e3430fa0 Mon Sep 17 00:00:00 2001 From: Cameron Wong Date: Wed, 29 Jul 2020 11:52:02 -0400 Subject: [PATCH 1/5] preliminary using_terminal groundwork Signed-off-by: Cameron Wong --- src/dune/action.ml | 7 +++++-- src/dune/action_ast.ml | 1 + src/dune/action_dune_lang.ml | 3 ++- src/dune/action_exec.ml | 6 ++++++ src/dune/action_intf.ml | 1 + src/dune/action_mapper.ml | 1 + src/dune/action_to_sh.ml | 1 + src/dune/action_unexpanded.ml | 5 ++++- 8 files changed, 21 insertions(+), 4 deletions(-) diff --git a/src/dune/action.ml b/src/dune/action.ml index e808c57a491..85f741b1b98 100644 --- a/src/dune/action.ml +++ b/src/dune/action.ml @@ -158,7 +158,8 @@ let fold_one_step t ~init:acc ~f = | Redirect_in (_, _, t) | Ignore (_, t) | With_accepted_exit_codes (_, t) - | No_infer t -> + | No_infer t + | Using_terminal t -> f acc t | Progn l | Pipe (_, l) -> @@ -205,7 +206,8 @@ let rec is_dynamic = function | Redirect_in (_, _, t) | Ignore (_, t) | With_accepted_exit_codes (_, t) - | No_infer t -> + | No_infer t + | Using_terminal t -> is_dynamic t | Progn l | Pipe (_, l) -> @@ -290,6 +292,7 @@ let is_useful_to distribute memoize = | With_accepted_exit_codes (_, t) | No_infer t -> loop t + | Using_terminal t -> loop t | Progn l | Pipe (_, l) -> List.exists l ~f:loop diff --git a/src/dune/action_ast.ml b/src/dune/action_ast.ml index c1d080fe03e..63ff59e4931 100644 --- a/src/dune/action_ast.ml +++ b/src/dune/action_ast.ml @@ -268,6 +268,7 @@ struct ; target into ] | No_infer r -> List [ atom "no-infer"; encode r ] + | Using_terminal t -> List [ atom "using-terminal"; encode t ] | Pipe (outputs, l) -> List ( atom (sprintf "pipe-%s" (Outputs.to_string outputs)) diff --git a/src/dune/action_dune_lang.ml b/src/dune/action_dune_lang.ml index dfcb2fab70c..df53e62163b 100644 --- a/src/dune/action_dune_lang.ml +++ b/src/dune/action_dune_lang.ml @@ -47,7 +47,8 @@ let ensure_at_most_one_dynamic_run ~loc action = | Redirect_in (_, _, t) | Ignore (_, t) | With_accepted_exit_codes (_, t) - | No_infer t -> + | No_infer t + | Using_terminal t -> loop t | Run _ | Echo _ diff --git a/src/dune/action_exec.ml b/src/dune/action_exec.ml index bb55101cdce..6203c0555ee 100644 --- a/src/dune/action_exec.ml +++ b/src/dune/action_exec.ml @@ -3,6 +3,9 @@ open Import open Fiber.O module DAP = Dune_action_plugin.Private.Protocol +(* This feels like the wrong place for this, but I'm not sure of a better one. *) +let terminal_lock = Fiber.Mutex.create () + (** A version of [Dune_action_plugin.Private.Protocol.Dependency] where all relative paths are replaced by [Path.t]. (except the protocol doesn't support Globs yet) *) @@ -351,6 +354,9 @@ let rec exec t ~ectx ~eenv = Io.write_lines target (String.Set.to_list lines); Fiber.return Done | No_infer t -> exec t ~ectx ~eenv + | Using_terminal t -> + (* CR cwong: Unbuffer the output of this job *) + Fiber.Mutex.with_lock terminal_lock (fun () -> exec t ~ectx ~eenv) | Pipe (outputs, l) -> exec_pipe ~ectx ~eenv outputs l | Format_dune_file (src, dst) -> Format_dune_lang.format_file ~input:(Some src) diff --git a/src/dune/action_intf.ml b/src/dune/action_intf.ml index c50bdfd5b12..f4f5787659e 100644 --- a/src/dune/action_intf.ml +++ b/src/dune/action_intf.ml @@ -47,6 +47,7 @@ module type Ast = sig | Diff of (path, target) Diff.t | Merge_files_into of path list * string list * target | No_infer of t + | Using_terminal of t | Pipe of Outputs.t * t list | Format_dune_file of path * target end diff --git a/src/dune/action_mapper.ml b/src/dune/action_mapper.ml index 9465a22b051..ab34c4f1a28 100755 --- a/src/dune/action_mapper.ml +++ b/src/dune/action_mapper.ml @@ -50,6 +50,7 @@ module Make (Src : Action_intf.Ast) (Dst : Action_intf.Ast) = struct , List.map extras ~f:(f_string ~dir) , f_target ~dir target ) | No_infer t -> No_infer (f t ~dir) + | Using_terminal t -> Using_terminal (f t ~dir) | Pipe (outputs, l) -> Pipe (outputs, List.map l ~f:(fun t -> f t ~dir)) | Format_dune_file (src, dst) -> Format_dune_file (f_path ~dir src, f_target ~dir dst) diff --git a/src/dune/action_to_sh.ml b/src/dune/action_to_sh.ml index d7534bc836e..5741ca0ecf1 100644 --- a/src/dune/action_to_sh.ml +++ b/src/dune/action_to_sh.ml @@ -88,6 +88,7 @@ let simplify act = (String.quote_for_shell target)) :: acc | No_infer act -> loop act acc + | Using_terminal act -> loop act acc | Pipe (outputs, l) -> Pipe (List.map ~f:block l, outputs) :: acc | Format_dune_file (src, dst) -> Redirect_out diff --git a/src/dune/action_unexpanded.ml b/src/dune/action_unexpanded.ml index be777232a8d..30ce5deb60c 100644 --- a/src/dune/action_unexpanded.ml +++ b/src/dune/action_unexpanded.ml @@ -201,6 +201,7 @@ module Partial = struct , List.map ~f:(E.string ~expander) extras , E.target ~expander target ) | No_infer t -> No_infer (expand t ~expander) + | Using_terminal t -> Using_terminal (expand t ~expander) | Pipe (outputs, l) -> Pipe (outputs, List.map l ~f:(expand ~expander)) | Format_dune_file (src, dst) -> Format_dune_file (E.path ~expander src, E.target ~expander dst) @@ -316,6 +317,7 @@ let rec partial_expand t ~expander : Partial.t = , List.map extras ~f:(E.string ~expander) , E.target ~expander target ) | No_infer t -> No_infer (partial_expand t ~expander) + | Using_terminal t -> Using_terminal (partial_expand t ~expander) | Pipe (outputs, l) -> Pipe (outputs, List.map l ~f:(partial_expand ~expander)) | Format_dune_file (src, dst) -> Format_dune_file (E.path ~expander src, E.target ~expander dst) @@ -422,7 +424,8 @@ end = struct acc +< src +@+ dst | Chdir (_, t) | Setenv (_, _, t) - | Ignore (_, t) -> + | Ignore (_, t) + | Using_terminal t -> infer acc t | Progn l | Pipe (_, l) -> From 101c1029a1992afed36d512879ba07729fd4b15e Mon Sep 17 00:00:00 2001 From: Cameron Wong Date: Wed, 29 Jul 2020 19:55:56 -0400 Subject: [PATCH 2/5] change using_terminal outputs to actually use stdin/stdout Signed-off-by: Cameron Wong --- src/dune/action_exec.ml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/dune/action_exec.ml b/src/dune/action_exec.ml index 6203c0555ee..799361ce2e8 100644 --- a/src/dune/action_exec.ml +++ b/src/dune/action_exec.ml @@ -355,8 +355,13 @@ let rec exec t ~ectx ~eenv = Fiber.return Done | No_infer t -> exec t ~ectx ~eenv | Using_terminal t -> - (* CR cwong: Unbuffer the output of this job *) - Fiber.Mutex.with_lock terminal_lock (fun () -> exec t ~ectx ~eenv) + Fiber.Mutex.with_lock terminal_lock (fun () -> + exec t ~ectx + ~eenv: + { eenv with + stdout_to = Process.Io.stdout + ; stderr_to = Process.Io.stderr + }) | Pipe (outputs, l) -> exec_pipe ~ectx ~eenv outputs l | Format_dune_file (src, dst) -> Format_dune_lang.format_file ~input:(Some src) From d84f2354508522aa1deec72fb36d6dc70defc1dc Mon Sep 17 00:00:00 2001 From: Cameron Wong Date: Thu, 10 Sep 2020 11:52:04 -0400 Subject: [PATCH 3/5] Capture console output within [Using_terminal] actions Signed-off-by: Cameron Wong --- src/dune_engine/action_exec.ml | 18 +++++++++++------ src/stdune/console.ml | 36 ++++++++++++++++++++++++++++++++++ src/stdune/console.mli | 9 +++++++++ 3 files changed, 57 insertions(+), 6 deletions(-) diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml index 64e09f07652..ffa07b7e03a 100644 --- a/src/dune_engine/action_exec.ml +++ b/src/dune_engine/action_exec.ml @@ -4,6 +4,7 @@ open Fiber.O module DAP = Dune_action_plugin.Private.Protocol let terminal_lock = Fiber.Mutex.create () + (* CR-someday cwong: Adjust this to be a nicer design. It would be ideal if we could generally allow actions to be extended. *) let cram_run = Fdecl.create (fun _ -> Dyn.Opaque) @@ -358,12 +359,17 @@ let rec exec t ~ectx ~eenv = | No_infer t -> exec t ~ectx ~eenv | Using_terminal t -> Fiber.Mutex.with_lock terminal_lock (fun () -> - exec t ~ectx - ~eenv: - { eenv with - stdout_to = Process.Io.stdout - ; stderr_to = Process.Io.stderr - }) + Console.lock (); + let* result = + exec t ~ectx + ~eenv: + { eenv with + stdout_to = Process.Io.stdout + ; stderr_to = Process.Io.stderr + } + in + Console.unlock (); + Fiber.return result) | Pipe (outputs, l) -> exec_pipe ~ectx ~eenv outputs l | Format_dune_file (src, dst) -> Format_dune_lang.format_file ~input:(Some src) diff --git a/src/stdune/console.ml b/src/stdune/console.ml index fe85a640def..c5f7a8043bb 100644 --- a/src/stdune/console.ml +++ b/src/stdune/console.ml @@ -69,10 +69,38 @@ module Backend = struct let reset () = Dumb.reset () end + module Buffered = struct + type event = + | Message of User_message.t + | Reset + + let underlying = ref (module Dumb : S) + + let buffer : event Queue.t = Queue.create () + + let print_user_message msg = Queue.push buffer (Message msg) + + let set_status_line _ = () + + (* I'm unsure of what the behavior should be here. My gut tells me that it + is less surprising to do nothing (and thus preserving the entire log), + but it may also be more correct to render the buffered outbut in its + entirety, resets and all. *) + let reset () = Queue.push buffer Reset + + let restore () = + let (module P : S) = !underlying in + Queue.iter buffer ~f:(function + | Message msg -> P.print_user_message msg + | Reset -> P.reset ()) + end + let dumb = (module Dumb : S) let progress = (module Progress : S) + let buffered = (module Buffered : S) + let main = ref dumb let set t = main := t @@ -107,6 +135,14 @@ let reset () = let (module M : Backend.S) = !Backend.main in M.reset () +let lock () = + Backend.Buffered.underlying := !Backend.main; + Backend.main := Backend.buffered + +let unlock () = + Backend.Buffered.restore (); + Backend.main := !Backend.Buffered.underlying + module Status_line = struct type t = unit -> User_message.Style.t Pp.t option diff --git a/src/stdune/console.mli b/src/stdune/console.mli index fa3ee4231a4..c90e1f1fb60 100644 --- a/src/stdune/console.mli +++ b/src/stdune/console.mli @@ -41,6 +41,15 @@ include Backend.S {[ print_user_message (User_message.make paragraphs) ]} *) val print : User_message.Style.t Pp.t list -> unit +(** [lock] captures any messages written to the console, which are rendered in + the previous console mode upon being [unlock]ed. + + To allow these to be used alongside [Fiber] jobs, we expose this unsafe + interface instead of [with_lock: (unit -> unit) -> unit]. *) +val lock : unit -> unit + +val unlock : unit -> unit + module Status_line : sig (** This module allows to buffer status updates so that they don't slow down the application *) From da7cf8e8cd679e81bb9cb2eb7e4c4171f6e860e7 Mon Sep 17 00:00:00 2001 From: Cameron Wong Date: Sun, 13 Sep 2020 22:21:05 -0400 Subject: [PATCH 4/5] fix clear buffer after printing logs Signed-off-by: Cameron Wong --- src/stdune/console.ml | 3 ++- src/stdune/console.mli | 4 +++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/stdune/console.ml b/src/stdune/console.ml index c5f7a8043bb..d7ce02242fc 100644 --- a/src/stdune/console.ml +++ b/src/stdune/console.ml @@ -92,7 +92,8 @@ module Backend = struct let (module P : S) = !underlying in Queue.iter buffer ~f:(function | Message msg -> P.print_user_message msg - | Reset -> P.reset ()) + | Reset -> P.reset ()); + Queue.clear buffer end let dumb = (module Dumb : S) diff --git a/src/stdune/console.mli b/src/stdune/console.mli index c90e1f1fb60..10f7b3c3800 100644 --- a/src/stdune/console.mli +++ b/src/stdune/console.mli @@ -45,7 +45,9 @@ val print : User_message.Style.t Pp.t list -> unit the previous console mode upon being [unlock]ed. To allow these to be used alongside [Fiber] jobs, we expose this unsafe - interface instead of [with_lock: (unit -> unit) -> unit]. *) + interface instead of [with_lock: (unit -> unit) -> unit]. Double-[lock]ing + or [unlock]ing the console will lead to output errors (no output, repeated + output, etc). *) val lock : unit -> unit val unlock : unit -> unit From dc0f388e830619d6ab3be5be7e71afd1006eb76a Mon Sep 17 00:00:00 2001 From: Cameron Wong Date: Wed, 16 Sep 2020 19:14:26 -0400 Subject: [PATCH 5/5] change console locking interface to be safe Signed-off-by: Cameron Wong --- bin/init.ml | 2 +- src/dune_engine/action_exec.ml | 21 +++++++------------ src/dune_engine/import.ml | 1 + src/{stdune => dune_util}/console.ml | 18 +++++++++++++++- src/{stdune => dune_util}/console.mli | 16 ++++++-------- src/dune_util/dune | 3 ++- src/fiber/dune | 1 + src/stdune/stdune.ml | 1 - test/expect-tests/common/dune_tests_common.ml | 2 +- 9 files changed, 36 insertions(+), 29 deletions(-) rename src/{stdune => dune_util}/console.ml (92%) rename src/{stdune => dune_util}/console.mli (78%) diff --git a/bin/init.ml b/bin/init.ml index 62f746ba643..0220565600f 100644 --- a/bin/init.ml +++ b/bin/init.ml @@ -65,7 +65,7 @@ let public_name_conv = let print_completion kind name = let open Pp.O in - Console.print_user_message + Dune_util.Console.print_user_message (User_message.make [ Pp.tag User_message.Style.Ok (Pp.verbatim "Success") ++ Pp.textf ": initialized %s component named " (Kind.to_string kind) diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml index ffa07b7e03a..a6624db4570 100644 --- a/src/dune_engine/action_exec.ml +++ b/src/dune_engine/action_exec.ml @@ -3,8 +3,6 @@ open Import open Fiber.O module DAP = Dune_action_plugin.Private.Protocol -let terminal_lock = Fiber.Mutex.create () - (* CR-someday cwong: Adjust this to be a nicer design. It would be ideal if we could generally allow actions to be extended. *) let cram_run = Fdecl.create (fun _ -> Dyn.Opaque) @@ -358,18 +356,13 @@ let rec exec t ~ectx ~eenv = Fiber.return Done | No_infer t -> exec t ~ectx ~eenv | Using_terminal t -> - Fiber.Mutex.with_lock terminal_lock (fun () -> - Console.lock (); - let* result = - exec t ~ectx - ~eenv: - { eenv with - stdout_to = Process.Io.stdout - ; stderr_to = Process.Io.stderr - } - in - Console.unlock (); - Fiber.return result) + Console.with_terminal_lock (fun () -> + exec t ~ectx + ~eenv: + { eenv with + stdout_to = Process.Io.stdout + ; stderr_to = Process.Io.stderr + }) | Pipe (outputs, l) -> exec_pipe ~ectx ~eenv outputs l | Format_dune_file (src, dst) -> Format_dune_lang.format_file ~input:(Some src) diff --git a/src/dune_engine/import.ml b/src/dune_engine/import.ml index 10797b01cac..5e8d9ae5ada 100644 --- a/src/dune_engine/import.ml +++ b/src/dune_engine/import.ml @@ -1,4 +1,5 @@ include Stdune +module Console = Dune_util.Console module Log = Dune_util.Log module Re = Dune_re diff --git a/src/stdune/console.ml b/src/dune_util/console.ml similarity index 92% rename from src/stdune/console.ml rename to src/dune_util/console.ml index d7ce02242fc..78706cfa11d 100644 --- a/src/stdune/console.ml +++ b/src/dune_util/console.ml @@ -1,3 +1,7 @@ +open Stdune + +let terminal_lock = Fiber.Mutex.create () + module Backend = struct module type S = sig val print_user_message : User_message.t -> unit @@ -144,6 +148,18 @@ let unlock () = Backend.Buffered.restore (); Backend.main := !Backend.Buffered.underlying +let with_terminal_lock f = + let open Fiber.O in + Fiber.Mutex.with_lock terminal_lock (fun () -> + lock (); + try + let* result = f () in + unlock (); + Fiber.return result + with e -> + unlock (); + raise e) + module Status_line = struct type t = unit -> User_message.Style.t Pp.t option @@ -155,7 +171,7 @@ module Status_line = struct | Some pp -> (* Always put the status line inside a horizontal to force the [Format] module to prefer a single line. In particular, it seems that - [Format.pp_print_text] split sthe line before the last word, unless it + [Format.pp_print_text] splits the line before the last word, unless it is succeeded by a space. This seems like a bug in [Format] and putting the whole thing into a [hbox] works around this bug. diff --git a/src/stdune/console.mli b/src/dune_util/console.mli similarity index 78% rename from src/stdune/console.mli rename to src/dune_util/console.mli index 10f7b3c3800..dffdad77c70 100644 --- a/src/stdune/console.mli +++ b/src/dune_util/console.mli @@ -5,6 +5,8 @@ be something else. This module allow to set a global backend for the application as well as composing backends. *) +open Stdune + module Backend : sig module type S = sig (** Format and print a user message to the console *) @@ -41,16 +43,10 @@ include Backend.S {[ print_user_message (User_message.make paragraphs) ]} *) val print : User_message.Style.t Pp.t list -> unit -(** [lock] captures any messages written to the console, which are rendered in - the previous console mode upon being [unlock]ed. - - To allow these to be used alongside [Fiber] jobs, we expose this unsafe - interface instead of [with_lock: (unit -> unit) -> unit]. Double-[lock]ing - or [unlock]ing the console will lead to output errors (no output, repeated - output, etc). *) -val lock : unit -> unit - -val unlock : unit -> unit +(** [with_terminal_lock f] will run [f ()] under a mutex, during which all + writes to the console (from [Backend]) will be buffered to be displayed upon + release of the lock. *) +val with_terminal_lock : (unit -> 'a Fiber.t) -> 'a Fiber.t module Status_line : sig (** This module allows to buffer status updates so that they don't slow down diff --git a/src/dune_util/dune b/src/dune_util/dune index 22b9f1c4d06..46c5148444f 100644 --- a/src/dune_util/dune +++ b/src/dune_util/dune @@ -1,4 +1,5 @@ (library (name dune_util) (public_name dune-private-libs.dune_util) - (libraries stdune)) + (libraries stdune fiber) + (synopsis "Internal dune library, do not use!")) diff --git a/src/fiber/dune b/src/fiber/dune index 3cb34f0e107..fea9100b259 100644 --- a/src/fiber/dune +++ b/src/fiber/dune @@ -1,4 +1,5 @@ (library (name fiber) (libraries stdune) + (public_name dune-private-libs.fiber) (synopsis "Monadic concurrency library")) diff --git a/src/stdune/stdune.ml b/src/stdune/stdune.ml index a39697804ef..4d743720ad2 100644 --- a/src/stdune/stdune.ml +++ b/src/stdune/stdune.ml @@ -4,7 +4,6 @@ module Array = Array module Bytes = Bytes module Char = Char module Comparator = Comparator -module Console = Console module Csexp = Csexp module Daemonize = Daemonize module Either = Either diff --git a/test/expect-tests/common/dune_tests_common.ml b/test/expect-tests/common/dune_tests_common.ml index 563327ab090..ca9c954d0d4 100644 --- a/test/expect-tests/common/dune_tests_common.ml +++ b/test/expect-tests/common/dune_tests_common.ml @@ -10,7 +10,7 @@ let init = ( Printexc.record_backtrace false; Path.set_root (Path.External.cwd ()); Path.Build.set_build_dir (Path.Build.Kind.of_string "_build"); - Console.Backend.(set dumb); + Dune_util.Console.Backend.(set dumb); Dune_util.Log.init () ) in fun () -> Lazy.force init