0005138: option "-j" doesn't parallelize processes on windows

View Issue Details [ Jump to Notes ]

[ Issue History ] [ Print ]

Project

Category

View Status

Date Submitted

Last Update

0005138

OCaml

OCamlbuild (the tool)

public

2010-08-31 16:19

2012-09-06 19:22

Reporter

daweil

Assigned To

xclerc

Priority

normal

Severity

major

Reproducibility

always

Status

assigned

Resolution

open

Platform

Windows

OS Version

any

Product Version

Target Version

4.00.2+dev

Fixed in Version

Summary

0005138: option "-j" doesn't parallelize processes on windows

Description

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

Issue History
Date Modified	Username	Field	Change
2010-08-31 16:19	daweil	New Issue
2011-04-29 11:21	doligez	Assigned To	=> xclerc
2011-04-29 11:21	doligez	Status	new => acknowledged
2011-06-06 13:00	xclerc	Relationship added	related to 0004935
2011-06-06 13:02	xclerc	Status	acknowledged => assigned
2012-02-02 15:17	protz	Category	OCamlbuild => OCamlbuild (the tool)
2012-07-06 16:31	doligez	Note Added: 0007646
2012-07-06 16:31	doligez	Target Version	=> 4.01.0+dev
2012-07-31 13:36	doligez	Target Version	4.01.0+dev => 4.00.1+dev
2012-09-06 19:22	frisch	Target Version	4.00.1+dev => 4.00.2+dev

Notes
(0007646) doligez (manager) 2012-07-06 16:31	Note: before applying this patch, check whether Filename.quote still overquotes the occurrences of &&.