Delay the creation of the context used when a package failed to build up until the package failed

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 () =
     let open OpamStd.Option.Op in
     String.concat " | " [
       OpamVersion.(to_string current);
@@ -687,7 +687,7 @@ let make_command st opam ?dir ?text_command (cmd, args) =
   in
   OpamSystem.make_command ~env ~name ?dir ~text
     ~resolve_path:OpamStateConfig.(not !r.dryrun)
-    ~metadata:["context", context]
+    ~metadata:(lazy ["context", context ()])
     ~verbose:(OpamConsole.verbose () ||
               OpamPackage.Name.Set.mem (OpamPackage.name nv)
                 OpamClientConfig.(!r.verbose_on))

src/client/opamCliMain.ml

@@ -385,7 +385,8 @@ let rec main_catch_all f =
         OpamConsole.errmsg "%s Command %S failed:\n%s\n"
           (OpamConsole.colorise `red "[ERROR]")
           (try
-             OpamStd.List.assoc String.equal "command" result.OpamProcess.r_info
+             OpamStd.List.assoc String.equal "command"
+               (Lazy.force result.OpamProcess.r_info)
            with Not_found -> "")
           (Printexc.to_string e);
         OpamConsole.errmsg "%s" (OpamStd.Exn.pretty_backtrace e);

src/client/opamSolution.ml

@@ -294,7 +294,8 @@ module Json = struct
       `O [ ("process-error",
             `O ([ ("code", `String (string_of_int r_code));
                   ("duration", `Float r_duration);
-                  ("info", `O (lmap (fun (k,v) -> (k, `String v)) r_info)); ]
+                  ("info", `O (lmap (fun (k,v) -> (k, `String v))
+                                 (Lazy.force r_info))); ]
                 @ if OpamCoreConfig.(!r.merged_output) then
                   [("output", `A (lmap (fun s -> `String s) r_stdout))]
                 else

src/core/opamFilename.mli

@@ -63,7 +63,8 @@ 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) list Lazy.t -> ?keep_going:bool ->
+  string list list -> unit
 
 (** Move a directory *)
 val move_dir: src:Dir.t -> dst:Dir.t -> unit

src/core/opamParallel.ml

@@ -292,7 +292,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 =

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) list Lazy.t option;
 }
 
 let string_of_command c = String.concat " " (c.cmd::c.args)
@@ -249,11 +249,17 @@ type t = {
   p_stderr : string option;
   p_env    : string option;
   p_info   : string option;
-  p_metadata: (string * string) list;
+  p_metadata: (string * string) list Lazy.t;
   p_verbose: bool;
   p_tmp_files: string list;
 }
 
+let equal p1 p2 =
+  (p1.p_pid : int) = (p2.p_pid : int)
+
+let compare p1 p2 =
+  Int.compare p1.p_pid p2.p_pid
+
 let output_lines oc lines =
   List.iter (fun line ->
     output_string oc line;
@@ -328,7 +334,8 @@ let create_process_env =
     environment can also be overridden if [env] is set. The environment
     which is used to run the process is recorded into [env_file] (if
     set). *)
-let create ?info_file ?env_file ?(allow_stdin=not Sys.win32) ?stdout_file ?stderr_file ?env ?(metadata=[]) ?dir
+let create ?info_file ?env_file ?(allow_stdin=not Sys.win32)
+    ?stdout_file ?stderr_file ?env ?(metadata=Lazy.from_val []) ?dir
     ~verbose ~tmp_files cmd args =
   let nothing () = () in
   let tee f =
@@ -388,7 +395,9 @@ let create ?info_file ?env_file ?(allow_stdin=not Sys.win32) ?stdout_file ?stder
     | Some f ->
       let chan = open_out f in
       let info =
-        make_info ~cmd ~args ~cwd ~env_file ~stdout_file ~stderr_file ~metadata () in
+        make_info ~cmd ~args ~cwd ~env_file ~stdout_file ~stderr_file
+          ~metadata:(Lazy.force metadata) ()
+      in
       output_string chan (string_of_info info);
       close_out chan in
 
@@ -478,7 +487,7 @@ type result = {
   r_code     : int;
   r_signal   : int option;
   r_duration : float;
-  r_info     : (string * string) list;
+  r_info     : (string * string) list Lazy.t;
   r_stdout   : string list;
   r_stderr   : string list;
   r_cleanup  : string list;
@@ -488,7 +497,7 @@ let empty_result = {
   r_code = 0;
   r_signal = None;
   r_duration = 0.;
-  r_info = [];
+  r_info = Lazy.from_val [];
   r_stdout = [];
   r_stderr = [];
   r_cleanup = [];
@@ -574,7 +583,7 @@ let dry_run_background c = {
   p_stderr = None;
   p_env    = None;
   p_info   = None;
-  p_metadata = OpamStd.Option.default [] c.cmd_metadata;
+  p_metadata = OpamStd.Option.default (Lazy.from_val []) c.cmd_metadata;
   p_verbose = is_verbose_command c;
   p_tmp_files = [];
 }
@@ -606,7 +615,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 String.compare files in
     let ics =
       List.map
         (open_in_gen [Open_nonblock;Open_rdonly;Open_text;Open_creat] 0o600)
@@ -652,10 +661,12 @@ let exit_status p return =
      if p.p_stdout <> p.p_stderr then
      List.iter verbose_print_out stderr;
      flush Stdlib.stdout);
-  let info =
+  let info = lazy begin
     make_info ?code ?signal
-      ~cmd:p.p_name ~args:p.p_args ~cwd:p.p_cwd ~metadata:p.p_metadata
-      ~env_file:p.p_env ~stdout_file:p.p_stdout ~stderr_file:p.p_stderr () in
+      ~cmd:p.p_name ~args:p.p_args ~cwd:p.p_cwd
+      ~metadata:(Lazy.force p.p_metadata) ~env_file:p.p_env
+      ~stdout_file:p.p_stdout ~stderr_file:p.p_stderr ()
+  end in
   {
     r_code     = OpamStd.Option.default 256 code;
     r_signal   = signal;
@@ -819,7 +830,7 @@ let string_of_result ?(color=`yellow) r =
     print str;
     Buffer.add_char b '\n' in
 
-  print (string_of_info ~color r.r_info);
+  print (string_of_info ~color (Lazy.force r.r_info));
 
   if r.r_stdout <> [] then
     if r.r_stderr = r.r_stdout then
@@ -843,7 +854,7 @@ let string_of_result ?(color=`yellow) r =
 
 let result_summary r =
   Printf.sprintf "%S exited with code %d%s"
-    (try OpamStd.List.assoc String.equal "command" r.r_info
+    (try OpamStd.List.assoc String.equal "command" (Lazy.force r.r_info)
      with Not_found -> "command")
     r.r_code
     (if r.r_code = 0 then "" else

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) list Lazy.t 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) list Lazy.t ->
   ?dir:string ->
   ?allow_stdin:bool ->
   ?stdout:string ->
@@ -71,19 +71,22 @@ 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) list Lazy.t; (** 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
                                 completion *)
 }
 
+val equal : t -> t -> bool
+val compare : t -> t -> int
+
 (** Process results *)
 type result = {
   r_code     : int;         (** Process exit code, or 256 on error *)
   r_signal   : int option;  (** Signal received if the processed was killed *)
   r_duration : float;       (** Process duration *)
-  r_info     : (string * string) list; (** Process info *)
+  r_info     : (string * string) list Lazy.t; (** Process info *)
   r_stdout   : string list; (** Content of stdout dump file *)
   r_stderr   : string list; (** Content of stderr dump file *)
   r_cleanup  : string list; (** List of files to clean-up *)

src/core/opamSystem.mli

@@ -186,8 +186,8 @@ 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 ->
-  ?dir:string -> ?resolve_path:bool ->
+  ?metadata:(string * string) list Lazy.t -> ?allow_stdin:bool ->
+  ?stdout:string -> ?dir:string -> ?resolve_path:bool ->
   string -> string list -> OpamProcess.command
 
 (** OLD COMMAND API, DEPRECATED *)
@@ -222,14 +222,15 @@ 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) list Lazy.t -> ?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) list Lazy.t -> ?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
@@ -238,7 +239,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) list Lazy.t -> ?allow_stdin:bool ->
   ?ignore_stderr:bool -> command -> string list
 
 (** END *)