diff --git a/.depend b/.depend index 188da25a..374fe4ff 100644 --- a/.depend +++ b/.depend @@ -676,13 +676,11 @@ src/rule.cmi : \ src/my_std.cmi \ src/command.cmi src/shell.cmo : \ - src/tags.cmi \ src/my_unix.cmi \ src/my_std.cmi \ src/log.cmi \ src/shell.cmi src/shell.cmx : \ - src/tags.cmx \ src/my_unix.cmx \ src/my_std.cmx \ src/log.cmx \ diff --git a/src/command.ml b/src/command.ml index 35a4b8eb..44497cc7 100644 --- a/src/command.ml +++ b/src/command.ml @@ -280,33 +280,7 @@ let execute_many ?(quiet=false) ?(pretend=false) cmds = else begin reset_filesys_cache (); - if Sys.win32 then - let res, opt_exn = - List.fold_left begin fun (acc_res, acc_exn) cmds -> - match acc_exn with - | None -> - begin try - List.iter begin fun action -> - let cmd = action () in - (* Redirect stderr to stdout to match the - behavior of My_unix.execute_many *) - let rc = sys_command (cmd ^ " 2>&1") in - if rc <> 0 then begin - if not quiet then - eprintf "Command exited with code %d." rc; - raise (Exit_with_code rc) - end - end cmds; - true :: acc_res, None - with e -> false :: acc_res, Some e - end - | Some _ -> false :: acc_res, acc_exn - end ([], None) konts - in match opt_exn with - | Some(exn) -> Some(List.rev res, exn) - | None -> None - else - My_unix.execute_many ~ticker ?max_jobs ~display konts + My_unix.execute_many ~ticker ?max_jobs ~display konts end end ;; diff --git a/src/ocamlbuild_executor.ml b/src/ocamlbuild_executor.ml index 8e5b0977..b9aeb74b 100644 --- a/src/ocamlbuild_executor.ml +++ b/src/ocamlbuild_executor.ml @@ -73,7 +73,10 @@ let output_lines prefix oc buffer = try String.index_from u i '\n' with Not_found -> m in - output_line i j; + (* ignore trailing CR *) + let k = ref j in + while !k > (i : int) && u.[!k - 1] = '\r' do decr k done; + output_line i !k; loop (j + 1) else () @@ -133,11 +136,18 @@ let execute (* ***) (*** add_job *) let add_job cmd rest result id = + let cmd = + if Sys.win32 + then "bash --norc -c " ^ Filename.quote cmd + else cmd + in (*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'); + if not Sys.win32 then begin + set_nonblock (doi stdout'); + set_nonblock (doi stderr'); + end; let job = { job_id = id; job_command = cmd; @@ -245,8 +255,10 @@ let execute decr jobs_active; (* PR#5371: we would get EAGAIN below otherwise *) - clear_nonblock (doi job.job_stdout); - clear_nonblock (doi job.job_stderr); + if not Sys.win32 then begin + clear_nonblock (doi job.job_stdout); + clear_nonblock (doi job.job_stderr); + end; do_read ~loop:true (doi job.job_stdout) job; do_read ~loop:true (doi job.job_stderr) job; diff --git a/src/shell.ml b/src/shell.ml index 5bcc6b6b..8bbd853b 100644 --- a/src/shell.ml +++ b/src/shell.ml @@ -24,33 +24,36 @@ let is_simple_filename s = | 'a'..'z' | 'A'..'Z' | '0'..'9' | '.' | '-' | '/' | '_' | ':' | '@' | '+' | ',' -> loop (pos + 1) | _ -> false in loop 0 + +(*** Copied from ocaml/stdlib/filename.ml *) +let generic_quote quotequote s = + let l = String.length s in + let b = Buffer.create (l + 20) in + Buffer.add_char b '\''; + for i = 0 to l - 1 do + if s.[i] = '\'' + then Buffer.add_string b quotequote + else Buffer.add_char b s.[i] + done; + Buffer.add_char b '\''; + Buffer.contents b + +let unix_quote = generic_quote "'\\''" + let quote_filename_if_needed s = if is_simple_filename s then s - (* We should probably be using [Filename.unix_quote] except that function - * isn't exported. Users on Windows will have to live with not being able to - * install OCaml into c:\o'caml. Too bad. *) - else if Sys.win32 then Printf.sprintf "'%s'" s - else Filename.quote s + else unix_quote s + let chdir dir = reset_filesys_cache (); Sys.chdir dir -let run args target = +let run args = reset_readdir_cache (); let cmd = String.concat " " (List.map quote_filename_if_needed args) in - if Sys.win32 then - begin - Log.event cmd target Tags.empty; - let st = sys_command cmd in - if st <> 0 then - failwith (Printf.sprintf "Error during command `%s'.\nExit code %d.\n" cmd st) - else - () - end - else - match My_unix.execute_many ~ticker:Log.update ~display:Log.display [[(fun () -> cmd)]] with - | None -> () - | Some(_, x) -> - failwith (Printf.sprintf "Error during command %S: %s" cmd (Printexc.to_string x)) + match My_unix.execute_many ~ticker:Log.update ~display:Log.display [[(fun () -> cmd)]] with + | None -> () + | Some(_, x) -> + failwith (Printf.sprintf "Error during command %S: %s" cmd (Printexc.to_string x)) let rm = sys_remove let rm_f x = if sys_file_exists x then () @@ -69,7 +72,7 @@ let rm_f x = let mkdir dir = reset_filesys_cache_for_file dir; (*Sys.mkdir dir (* MISSING in ocaml *) *) - run ["mkdir"; dir] dir + run ["mkdir"; dir] let try_mkdir dir = if not (sys_file_exists dir) @@ -95,7 +98,7 @@ let rec mkdir_p dir = let cp_pf src dest = reset_filesys_cache_for_file dest; - run["cp";"-pf";src;dest] dest + run["cp";"-pf";src;dest] (* Archive files are handled specially during copy *) let cp src dst = @@ -109,9 +112,9 @@ let readlink = My_unix.readlink let is_link = My_unix.is_link let rm_rf x = reset_filesys_cache (); - run["rm";"-Rf";x] x + run["rm";"-Rf";x] let mv src dest = reset_filesys_cache_for_file src; reset_filesys_cache_for_file dest; - run["mv"; src; dest] dest + run["mv"; src; dest] (*Sys.rename src dest*)