MPR#5138: option "-j" doesn't parallelize processes on windows

[damiendoligez]

PR transferred from https://caml.inria.fr/mantis/view.php?id=5138
[original reporter: Daniel Weil]

here are the change I make to make it works. But this must be validated.

diff -ur ocaml-3.12.0/ocamlbuild/command.ml ocaml-3.12.0_patched_win32VC9/ocamlbuild/command.ml
--- ocaml-3.12.0/ocamlbuild/command.ml	2010-02-03 14:11:19.000000000 +0100
+++ ocaml-3.12.0_patched_win32VC9/ocamlbuild/command.ml	2010-08-31 14:22:27.646472100 +0200
@@ -243,7 +243,7 @@
 
 let execute_many ?(quiet=false) ?(pretend=false) cmds =
   add_parallel_stat (List.length cmds);
- let degraded = !*My_unix.is_degraded || Sys.os_type = "Win32" in
+ let degraded = !*My_unix.is_degraded (*|| Sys.os_type = "Win32"*) in
   let jobs = !jobs in
   if jobs < 0 then invalid_arg "jobs < 0";
   let max_jobs = if jobs = 0 then None else Some jobs in
@@ -289,6 +289,7 @@
             | Some(exn) -> Some(List.rev res, exn)
             | None -> None
           else
+ let konts = List.map (List.map (fun f -> (fun () -> My_std.quote_command (f ())))) konts in
             My_unix.execute_many ~ticker ?max_jobs ~display konts
         end
     end
diff -ur ocaml-3.12.0/ocamlbuild/my_std.ml ocaml-3.12.0_patched_win32VC9/ocamlbuild/my_std.ml
--- ocaml-3.12.0/ocamlbuild/my_std.ml	2010-01-22 13:48:24.000000000 +0100
+++ ocaml-3.12.0_patched_win32VC9/ocamlbuild/my_std.ml	2010-08-31 14:13:31.960883900 +0200
@@ -243,8 +243,17 @@
       if basename = Filename.current_dir_name then true else
       try Array.iter (fun x -> if x = basename then raise Exit) a; false
       with Exit -> true
+ 
+let quote_command = 
+ match Sys.os_type with
+ | "Win32" -> fun cmd ->
+ if cmd = "" then "" else
+ let cmd = "bash -c "^Filename.quote cmd in
+ (* FIXME fix Filename.quote for windows *)
+ String.subst "\"&\"\"&\"" "&&" cmd 
+ | _ -> fun cmd -> cmd
 
-let sys_command =
+let sys_command = 
   match Sys.os_type with
   | "Win32" -> fun cmd ->
       if cmd = "" then 0 else
diff -ur ocaml-3.12.0/ocamlbuild/my_std.mli ocaml-3.12.0_patched_win32VC9/ocamlbuild/my_std.mli
--- ocaml-3.12.0/ocamlbuild/my_std.mli	2009-03-03 17:54:58.000000000 +0100
+++ ocaml-3.12.0_patched_win32VC9/ocamlbuild/my_std.mli	2010-08-31 14:18:37.999968300 +0200
@@ -55,6 +55,7 @@
 val reset_filesys_cache : unit -> unit
 val reset_filesys_cache_for_file : string -> unit
 val sys_file_exists : string -> bool
+val quote_command : string -> string
 val sys_command : string -> int
 val filename_concat : string -> string -> string
 
diff -ur ocaml-3.12.0/ocamlbuild/ocamlbuild_executor.ml ocaml-3.12.0_patched_win32VC9/ocamlbuild/ocamlbuild_executor.ml
--- ocaml-3.12.0/ocamlbuild/ocamlbuild_executor.ml	2010-01-22 13:48:24.000000000 +0100
+++ ocaml-3.12.0_patched_win32VC9/ocamlbuild/ocamlbuild_executor.ml	2010-08-31 15:31:44.893519900 +0200
@@ -77,6 +77,7 @@
   in
   loop 0
 ;;
+
 (* ***)
 (*** execute *)
 (* XXX: Add test for non reentrancy *)
@@ -133,8 +134,8 @@
     (*display begin fun oc -> fp oc "Job %a is %s\n%!" print_job_id id cmd; end;*)
     let (stdout', stdin', stderr') = open_process_full cmd env in
     incr jobs_active;
- set_nonblock (doi stdout');
- set_nonblock (doi stderr');
+ (*set_nonblock (doi stdout');
+ set_nonblock (doi stderr');*)
     let job =
       { job_id = id;
         job_command = cmd;
diff -ur ocaml-3.12.0/ocamlbuild/shell.ml ocaml-3.12.0_patched_win32VC9/ocamlbuild/shell.ml
--- ocaml-3.12.0/ocamlbuild/shell.ml	2010-02-03 11:27:46.000000000 +0100
+++ ocaml-3.12.0_patched_win32VC9/ocamlbuild/shell.ml	2010-08-24 09:26:19.810366300 +0200
@@ -30,7 +30,7 @@
 let run args target =
   reset_readdir_cache ();
   let cmd = String.concat " " (List.map quote_filename_if_needed args) in
- if !*My_unix.is_degraded || Sys.os_type = "Win32" then
+ if !*My_unix.is_degraded (*|| Sys.os_type = "Win32"*) then
     begin
       Log.event cmd target Tags.empty;
       let st = sys_command cmd in

[hhugo]

Fixed by #333