From 229e7fa883faf8828de4d009870630a6c77c68db Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 21 Apr 2017 17:22:41 +0100 Subject: [PATCH] A couple of fixes for Windows - open files in text mode when reading lines - open files used for redirections with O_SHARE_DELETE --- bootstrap.ml | 5 +++-- src/future.ml | 6 +++--- src/gen_rules.ml | 2 +- src/import.ml | 20 ++++++++++---------- src/main.ml | 1 + 5 files changed, 18 insertions(+), 16 deletions(-) diff --git a/bootstrap.ml b/bootstrap.ml index 2e3e5597..bc06d254 100644 --- a/bootstrap.ml +++ b/bootstrap.ml @@ -166,6 +166,7 @@ let read_deps files = print_endline cmd; Unix.open_process_in cmd in + set_binary_mode_in ic false; let rec loop acc = match input_line ic with | exception End_of_file -> @@ -222,7 +223,7 @@ let count_newlines s = !newlines let read_file fn = - let ic = open_in fn in + let ic = open_in_bin fn in let data = really_input_string ic (in_channel_length ic) in close_in ic; data @@ -230,7 +231,7 @@ let read_file fn = let generated_file = "boot.ml" let generate_file_with_all_the_sources () = - let oc = open_out generated_file in + let oc = open_out_bin generated_file in let pos_in_generated_file = ref 1 in let pr fmt = ksprintf (fun s -> diff --git a/src/future.ml b/src/future.ml index 23b3b1ab..2e921fb3 100644 --- a/src/future.ml +++ b/src/future.ml @@ -484,7 +484,7 @@ module Scheduler = struct Hashtbl.fold running ~init:[] ~f:(fun ~key:pid ~data:job acc -> let pid, status = Unix.waitpid [WNOHANG] pid in if pid <> 0 then begin - (job, status) :: acc + (job, status) :: acc end else acc) in @@ -546,7 +546,7 @@ module Scheduler = struct let get_std_output ~default = function | Terminal -> (default, None) | File fn -> - let fd = Unix.openfile fn [O_WRONLY; O_CREAT; O_TRUNC] 0o666 in + let fd = Unix.openfile fn [O_WRONLY; O_CREAT; O_TRUNC; O_SHARE_DELETE] 0o666 in (fd, Some (Fd fd)) | Opened_file { desc; tail; _ } -> let fd = @@ -578,7 +578,7 @@ module Scheduler = struct match job.stdout_to, job.stderr_to with | Terminal, _ | _, Terminal -> let fn = Temp.create "jbuilder" ".output" in - (Some fn, Unix.openfile fn [O_WRONLY] 0) + (Some fn, Unix.openfile fn [O_WRONLY; O_SHARE_DELETE] 0) | _ -> (None, Unix.stdin) in diff --git a/src/gen_rules.ml b/src/gen_rules.ml index d6f68909..6cce7184 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -1510,7 +1510,7 @@ module Gen(P : Params) = struct { m with obj_name = obj_name_of_basename m.impl.name }) in List.iter exes.names ~f:(fun name -> - if not (String_map.mem (String.capitalize name) modules) then + if not (String_map.mem (String.capitalize_ascii name) modules) then die "executable %s in %s doesn't have a corresponding .ml file" name (Path.to_string dir)); let modules = diff --git a/src/import.ml b/src/import.ml index ac5db884..8e89a561 100644 --- a/src/import.ml +++ b/src/import.ml @@ -9,9 +9,6 @@ external reraise : exn -> _ = "%reraise" (* To make bug reports usable *) let () = Printexc.record_backtrace true -let open_in = open_in_bin -let open_out = open_out_bin - let sprintf = Printf.sprintf let ksprintf = Printf.ksprintf @@ -391,11 +388,13 @@ let protectx x ~finally ~f = | y -> finally x; y | exception e -> finally x; raise e -let with_file_in fn ~f = - protectx (open_in fn) ~finally:close_in ~f +let with_file_in ?(binary=true) fn ~f = + protectx ((if binary then open_in_bin else open_in) fn) + ~finally:close_in ~f -let with_file_out fn ~f = - protectx (open_out fn) ~finally:close_out ~f +let with_file_out ?(binary=true)fn ~f = + protectx ((if binary then open_out_bin else open_out) fn) + ~finally:close_out ~f let with_lexbuf_from_file fn ~f = with_file_in fn ~f:(fun ic -> @@ -412,16 +411,17 @@ let input_lines = let rec loop ic acc = match input_line ic with | exception End_of_file -> List.rev acc - | line -> loop ic (line :: acc) + | line -> + loop ic (line :: acc) in fun ic -> loop ic [] let read_file fn = - protectx (open_in fn) ~finally:close_in ~f:(fun ic -> + protectx (open_in_bin fn) ~finally:close_in ~f:(fun ic -> let len = in_channel_length ic in really_input_string ic len) -let lines_of_file fn = with_file_in fn ~f:input_lines +let lines_of_file fn = with_file_in fn ~f:input_lines ~binary:false let write_file fn data = with_file_out fn ~f:(fun oc -> output_string oc data) diff --git a/src/main.ml b/src/main.ml index 0d8fbdbc..5ebd5a40 100644 --- a/src/main.ml +++ b/src/main.ml @@ -150,6 +150,7 @@ let bootstrap () = [ "-j" , Set_int Clflags.concurrency, "JOBS concurrency" ; "--dev" , Set Clflags.dev_mode , " set development mode" ; "--debug-rules", Set Clflags.debug_rules , " print out rules" + ; "--verbose" , Set Clflags.verbose , " print detailed information about commands being run" ] anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:"; let log = Log.create () in