From 33d921098a34ae39f54f0bae2b7b67d14a2ac8cf Mon Sep 17 00:00:00 2001 From: Kate Date: Tue, 29 Oct 2024 18:50:47 +0000 Subject: [PATCH] Delay the creation of the context used when a package failed to build up until the package failed --- src/client/opamAction.ml | 4 ++-- src/core/opamFilename.mli | 2 +- src/core/opamParallel.ml | 2 +- src/core/opamProcess.ml | 8 ++++---- src/core/opamProcess.mli | 6 +++--- src/core/opamSystem.mli | 8 ++++---- 6 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index 9fc844efd29..3439468db83 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -643,7 +643,7 @@ let make_command st opam ?dir ?text_command (cmd, args) = let cmd, args = OpamStd.Option.default (cmd, args) text_command in OpamProcess.make_command_text name ~args cmd in - let context = + let context = lazy begin let open OpamStd.Option.Op in String.concat " | " [ OpamVersion.(to_string current); @@ -684,7 +684,7 @@ let make_command st opam ?dir ?text_command (cmd, args) = OpamUrl.to_string repo.repo_url ^ OpamStd.Option.to_string (fun s -> "#"^s) stamp ] - in + end in OpamSystem.make_command ~env ~name ?dir ~text ~resolve_path:OpamStateConfig.(not !r.dryrun) ~metadata:["context", context] diff --git a/src/core/opamFilename.mli b/src/core/opamFilename.mli index ba3763bb454..ee0f7603dc2 100644 --- a/src/core/opamFilename.mli +++ b/src/core/opamFilename.mli @@ -63,7 +63,7 @@ val env_of_list: (string * string) list -> string array (** Execute a list of commands in a given directory *) val exec: Dir.t -> ?env:(string * string) list -> ?name:string -> - ?metadata:(string * string) list -> ?keep_going:bool -> string list list -> unit + ?metadata:(string * string Lazy.t) list -> ?keep_going:bool -> string list list -> unit (** Move a directory *) val move_dir: src:Dir.t -> dst:Dir.t -> unit diff --git a/src/core/opamParallel.ml b/src/core/opamParallel.ml index 49abe705d71..991c40a5d52 100644 --- a/src/core/opamParallel.ml +++ b/src/core/opamParallel.ml @@ -277,7 +277,7 @@ module Make (G : G) = struct | _ -> OpamProcess.wait_one (List.map fst processes) with e -> fail (fst (snd (List.hd processes))) e in - let n,cont = OpamStd.(List.assoc Compare.equal process processes) in + let n,cont = OpamStd.List.assoc OpamProcess.equal process processes in log "Collected task for job %a (ret:%d)" (slog (string_of_int @* V.hash)) n result.OpamProcess.r_code; let next = diff --git a/src/core/opamProcess.ml b/src/core/opamProcess.ml index 8c18e8f61a3..6f578418279 100644 --- a/src/core/opamProcess.ml +++ b/src/core/opamProcess.ml @@ -208,7 +208,7 @@ type command = { cmd_stdout: string option; cmd_verbose: bool option; cmd_name: string option; - cmd_metadata: (string * string) list option; + cmd_metadata: (string * string Lazy.t) list option; } let string_of_command c = String.concat " " (c.cmd::c.args) @@ -249,7 +249,7 @@ type t = { p_stderr : string option; p_env : string option; p_info : string option; - p_metadata: (string * string) list; + p_metadata: (string * string Lazy.t) list; p_verbose: bool; p_tmp_files: string list; } @@ -285,7 +285,7 @@ let make_info ?code ?signal | None -> () | Some s -> print name s in - List.iter (fun (k,v) -> print k v) metadata; + List.iter (fun (k,v) -> print k (Lazy.force v)) metadata; print "path" cwd; print "command" (String.concat " " (cmd :: args)); print_opt "exit-code" (OpamStd.Option.map string_of_int code); @@ -612,7 +612,7 @@ let set_verbose_f, print_verbose_f, isset_verbose_f, stop_verbose_f = (* implem relies on sigalrm, not implemented on win32. This will fall back to buffered output. *) if Sys.win32 then () else - let files = OpamStd.List.sort_nodup compare files in + let files = OpamStd.List.sort_nodup OpamStd.Compare.compare files in let ics = List.map (open_in_gen [Open_nonblock;Open_rdonly;Open_text;Open_creat] 0o600) diff --git a/src/core/opamProcess.mli b/src/core/opamProcess.mli index f38a3997af6..8b54258889b 100644 --- a/src/core/opamProcess.mli +++ b/src/core/opamProcess.mli @@ -22,7 +22,7 @@ type command = private { cmd_stdout: string option; cmd_verbose: bool option; cmd_name: string option; - cmd_metadata: (string * string) list option; + cmd_metadata: (string * string Lazy.t) list option; } (** Builds a shell command for later execution. @@ -40,7 +40,7 @@ val command: ?env:string array -> ?verbose:bool -> ?name:string -> - ?metadata:(string*string) list -> + ?metadata:(string * string Lazy.t) list -> ?dir:string -> ?allow_stdin:bool -> ?stdout:string -> @@ -71,7 +71,7 @@ type t = { p_stderr : string option; (** stderr dump file *) p_env : string option; (** dump environment variables *) p_info : string option; (** dump process info *) - p_metadata: (string * string) list; (** Metadata associated to the process *) + p_metadata: (string * string Lazy.t) list; (** Metadata associated to the process *) p_verbose: bool; (** whether output of the process should be displayed *) p_tmp_files: string list; (** temporary files that should be cleaned up upon diff --git a/src/core/opamSystem.mli b/src/core/opamSystem.mli index e015d23af5f..040c9f6f0e1 100644 --- a/src/core/opamSystem.mli +++ b/src/core/opamSystem.mli @@ -178,7 +178,7 @@ val directories_with_links: string -> string list case you can end up with a process error instead) *) val make_command: ?verbose:bool -> ?env:string array -> ?name:string -> ?text:string -> - ?metadata:(string * string) list -> ?allow_stdin:bool -> ?stdout:string -> + ?metadata:(string * string Lazy.t) list -> ?allow_stdin:bool -> ?stdout:string -> ?dir:string -> ?resolve_path:bool -> string -> string list -> OpamProcess.command @@ -214,14 +214,14 @@ val apply_cygpath: string -> string (** [command cmd] executes the command [cmd] in the correct OPAM environment. *) val command: ?verbose:bool -> ?env:string array -> ?name:string -> - ?metadata:(string * string) list -> ?allow_stdin:bool -> + ?metadata:(string * string Lazy.t) list -> ?allow_stdin:bool -> command -> unit (** [commands cmds] executes the commands [cmds] in the correct OPAM environment. It stops whenever one command fails unless [keep_going] is set to [true]. In this case, the first error is re-raised at the end. *) val commands: ?verbose:bool -> ?env:string array -> ?name:string -> - ?metadata:(string * string) list -> ?keep_going:bool -> command list -> unit + ?metadata:(string * string Lazy.t) list -> ?keep_going:bool -> command list -> unit (** [read_command_output cmd] executes the command [cmd] in the correct OPAM environment and return the lines from output if the command @@ -230,7 +230,7 @@ val commands: ?verbose:bool -> ?env:string array -> ?name:string -> It returns stdout and stder combiend, unless [ignore_stderr] is st to true. *) val read_command_output: ?verbose:bool -> ?env:string array -> - ?metadata:(string * string) list -> ?allow_stdin:bool -> + ?metadata:(string * string Lazy.t) list -> ?allow_stdin:bool -> ?ignore_stderr:bool -> command -> string list (** END *)