Merge pull request #1586 from OCamlPro/fix-solver-script-check

Workaround some solver scripts: run check with closed stdin

CHANGES

@@ -59,6 +59,8 @@
 * Added the 'build', 'test' and 'doc' dependency flags to limit the scope
   of some dependencies
 * Added Check for common dependencies at init time
+* Pinning to a local git directory will now automatically select the pin kind to
+  'git' (#1555)
 * Hundreds of smaller fixes and UI improvements
 
 1.1.2

src/core/opamProcess.ml

@@ -73,7 +73,7 @@ let string_of_info ?(color=`yellow) info =
         (OpamGlobals.colorise color k) v) info;
   Buffer.contents b
 
-let create ?info_file ?env_file ?stdout_file ?stderr_file ?env ?(metadata=[])
+let create ?info_file ?env_file ?(allow_stdin=true) ?stdout_file ?stderr_file ?env ?(metadata=[])
     ~verbose cmd args =
   let nothing () = () in
   let tee f =
@@ -88,6 +88,11 @@ let create ?info_file ?env_file ?stdout_file ?stderr_file ?env ?(metadata=[])
       Unix.descr_of_out_channel chan, close
     ) else
       fd, close_fd in
+  let stdin_fd =
+    if allow_stdin then Unix.stdin else
+      let fd = Unix.dup Unix.stdin in
+      Unix.close fd; fd
+  in
   let stdout_fd, close_stdout = match stdout_file with
     | None   -> Unix.stdout, nothing
     | Some f -> tee f in
@@ -128,7 +133,7 @@ let create ?info_file ?env_file ?stdout_file ?stderr_file ?env ?(metadata=[])
       cmd
       (Array.of_list (cmd :: args))
       env
-      Unix.stdin stdout_fd stderr_fd in
+      stdin_fd stdout_fd stderr_fd in
   close_stdout ();
   close_stderr ();
   {
@@ -195,7 +200,7 @@ let wait p =
     | _ -> iter () in
   iter ()
 
-let run ?env ?(verbose=false) ?name ?(metadata=[]) cmd args =
+let run ?env ?(verbose=false) ?name ?(metadata=[]) ?allow_stdin cmd args =
   let file f = match name with
     | None   -> None
     | Some n -> Some (f n) in
@@ -207,7 +212,7 @@ let run ?env ?(verbose=false) ?name ?(metadata=[]) cmd args =
 
   let p =
     create ~env ?info_file ?env_file ?stdout_file ?stderr_file ~verbose ~metadata
-      cmd args in
+      ?allow_stdin cmd args in
   wait p
 
 let is_success r = r.r_code = 0

src/core/opamProcess.mli

@@ -38,7 +38,8 @@ type t = {
     which is used to run the process is recorded into [env_file] (if
     set). *)
 val create :
-  ?info_file:string -> ?env_file:string -> ?stdout_file:string -> ?stderr_file:string ->
+  ?info_file:string -> ?env_file:string ->
+  ?allow_stdin:bool -> ?stdout_file:string -> ?stderr_file:string ->
   ?env:string array -> ?metadata:(string*string) list ->
   verbose:bool -> string -> string list -> t
 
@@ -61,7 +62,8 @@ val wait: t -> result
     created, and contains the process main description, the environment
     variables, the standard output and the standard error. *)
 val run : ?env:string array -> ?verbose:bool -> ?name:string ->
-  ?metadata:(string*string) list -> string -> string list -> result
+  ?metadata:(string*string) list -> ?allow_stdin:bool ->
+  string -> string list -> result
 
 (** Is the process result a success ? *)
 val is_success : result -> bool

src/core/opamSystem.ml

@@ -304,7 +304,7 @@ let log_file name = match name with
 let log_cleanup r =
   if not !OpamGlobals.debug then OpamProcess.clean_files r
 
-let run_process ?verbose ?(env=default_env) ~name ?metadata command =
+let run_process ?verbose ?(env=default_env) ~name ?metadata ?allow_stdin command =
   let chrono = OpamGlobals.timer () in
   runs := command :: !runs;
   match command with
@@ -321,7 +321,7 @@ let run_process ?verbose ?(env=default_env) ~name ?metadata command =
         | None   -> !OpamGlobals.debug || !OpamGlobals.verbose
         | Some b -> b in
 
-      let r = OpamProcess.run ~env ~name ~verbose ?metadata cmd args in
+      let r = OpamProcess.run ~env ~name ~verbose ?metadata ?allow_stdin cmd args in
       let str = String.concat " " (cmd :: args) in
       log "[%a] (in %.3fs) %s"
         (OpamGlobals.slog Filename.basename) name
@@ -331,9 +331,9 @@ let run_process ?verbose ?(env=default_env) ~name ?metadata command =
       (* Display a user-friendly message if the command does not exist *)
       command_not_found cmd
 
-let command ?verbose ?env ?name ?metadata cmd =
+let command ?verbose ?env ?name ?metadata ?allow_stdin cmd =
   let name = log_file name in
-  let r = run_process ?verbose ?env ~name ?metadata cmd in
+  let r = run_process ?verbose ?env ~name ?metadata ?allow_stdin cmd in
   if OpamProcess.is_success r then log_cleanup r
   else process_error r
 

src/core/opamSystem.mli

@@ -136,7 +136,8 @@ val command_exists: ?env:string array -> string -> bool
 (** [command cmd] executes the command [cmd] in the correct OPAM
     environment. *)
 val command: ?verbose:bool -> ?env:string array -> ?name:string ->
-  ?metadata:(string * string) list -> command -> unit
+  ?metadata:(string * string) 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

src/repositories/opamHTTP.ml

@@ -60,7 +60,7 @@ let make_state ~download_index repo =
         if OpamFilename.exists local_index_file then
           OpamFilename.move ~src:local_index_file ~dst:local_index_file_save;
         try
-	  OpamGlobals.msg "[%s] \tDownloading %s\n"
+	  OpamGlobals.msg "[%s] Downloading %s\n"
 	    (OpamGlobals.colorise `green
                (OpamRepositoryName.to_string repo.repo_name))
 	    (OpamFilename.to_string remote_index_file);
@@ -142,7 +142,7 @@ module B = struct
       let state = make_state ~download_index:true repo in
       try
         (* Download index.tar.gz *)
-	OpamGlobals.msg "[%s] \tDownloading %s\n"
+	OpamGlobals.msg "[%s] Downloading %s\n"
 	  (OpamGlobals.colorise `green
              (OpamRepositoryName.to_string repo.repo_name))
 	  (OpamFilename.to_string state.remote_index_archive);
@@ -210,13 +210,13 @@ module B = struct
        match checksum with
        | None   -> false
        | Some c -> OpamFilename.digest local_file = c then (
-      OpamGlobals.msg "[%s] \t%s is in the local cache, using it.\n"
+      OpamGlobals.msg "[%s] %s is in the local cache, using it.\n"
         (OpamGlobals.colorise `green (OpamPackage.to_string package))
         (OpamFilename.Base.to_string base);
       Result (F local_file)
     )
     else (
-      OpamGlobals.msg "[%s] \tDownloading %s\n"
+      OpamGlobals.msg "[%s] Downloading %s\n"
         (OpamGlobals.colorise `green (OpamPackage.to_string package))
         (OpamFilename.to_string filename);
       try
@@ -236,7 +236,7 @@ module B = struct
       if is_up_to_date state local_file then
         Up_to_date local_file
       else (
-	OpamGlobals.msg "[%s] \tDownloading %s\n"
+	OpamGlobals.msg "[%s] Downloading %s\n"
 	  (OpamGlobals.colorise `green
              (OpamRepositoryName.to_string repo.repo_name))
 	  (OpamFilename.prettify filename);

src/repositories/opamLocal.ml

@@ -90,7 +90,7 @@ module B = struct
 
   let pull_repo repo =
     log "pull-repo";
-    OpamGlobals.msg "[%s] \tSynchronizing with %s\n"
+    OpamGlobals.msg "[%s] Synchronizing with %s\n"
       (OpamGlobals.colorise `green
          (OpamRepositoryName.to_string repo.repo_name))
       (string_of_address repo.repo_address);
@@ -118,7 +118,7 @@ module B = struct
 
   let pull_file package local_dirname remote_filename =
     if OpamFilename.exists remote_filename then
-      OpamGlobals.msg "[%s] \tSynchronizing with %s\n"
+    OpamGlobals.msg "[%s] Synchronizing with %s\n"
         (OpamGlobals.colorise `green
            (OpamPackage.to_string package))
         (OpamFilename.to_string remote_filename);
@@ -145,7 +145,7 @@ module B = struct
 
   let pull_archive repo filename =
     if OpamFilename.exists filename then
-      OpamGlobals.msg "[%s] \tSynchronizing with %s\n"
+      OpamGlobals.msg "[%s] Synchronizing with %s\n"
         (OpamGlobals.colorise `green
            (OpamRepositoryName.to_string repo.repo_name))
         (OpamFilename.to_string filename);

src/repositories/opamVCS.ml

@@ -70,13 +70,13 @@ module Make (VCS: VCS) = struct
       | Some _ -> OpamGlobals.note "Skipping checksum for dev package %s"
                     (OpamPackage.to_string package) in
     let repo = repo dirname remote_url in
-    OpamGlobals.msg "[%s] \tFetching %s\n"
+    OpamGlobals.msg "[%s] Fetching %s\n"
       (OpamGlobals.colorise `green (OpamPackage.to_string package))
       (string_of_address remote_url);
     download_dir (pull_repo repo)
 
   let pull_repo repo =
-    OpamGlobals.msg "[%s] \tFetching %s\n"
+    OpamGlobals.msg "[%s] Fetching %s\n"
       (OpamGlobals.colorise `green
          (OpamRepositoryName.to_string repo.repo_name))
       (string_of_address repo.repo_address);
@@ -87,7 +87,7 @@ module Make (VCS: VCS) = struct
     let basename = OpamFilename.basename filename in
     let local_file = OpamFilename.create dirname basename in
     if OpamFilename.exists local_file then (
-      OpamGlobals.msg "[%s] \tUsing %s\n"
+      OpamGlobals.msg "[%s] Using %s\n"
         (OpamGlobals.colorise `green
            (OpamRepositoryName.to_string repo.repo_name))
         (OpamFilename.prettify local_file);

src/solver/opamCudf.ml

@@ -532,7 +532,9 @@ let check_cudf_version =
     if external_solver_available () then
       try
         log "Checking version of criteria accepted by the external solver";
-        OpamSystem.command ~verbose:false [OpamGlobals.get_external_solver(); "-v"];
+        (* Run with closed stdin to workaround bug in some solver scripts *)
+        OpamSystem.command ~verbose:false ~allow_stdin:false
+          [OpamGlobals.get_external_solver(); "-v"];
         log "Solver seems to accept latest version criteria";
         `Latest
       with OpamSystem.Process_error _ ->