A couple of fixes for Windows

- open files in text mode when reading lines
- open files used for redirections with O_SHARE_DELETE
This commit is contained in:
Jeremie Dimino 2017-04-21 17:22:41 +01:00
parent 52b326ab43
commit 229e7fa883
5 changed files with 18 additions and 16 deletions

View File

@ -166,6 +166,7 @@ let read_deps files =
print_endline cmd; print_endline cmd;
Unix.open_process_in cmd Unix.open_process_in cmd
in in
set_binary_mode_in ic false;
let rec loop acc = let rec loop acc =
match input_line ic with match input_line ic with
| exception End_of_file -> | exception End_of_file ->
@ -222,7 +223,7 @@ let count_newlines s =
!newlines !newlines
let read_file fn = 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 let data = really_input_string ic (in_channel_length ic) in
close_in ic; close_in ic;
data data
@ -230,7 +231,7 @@ let read_file fn =
let generated_file = "boot.ml" let generated_file = "boot.ml"
let generate_file_with_all_the_sources () = 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 pos_in_generated_file = ref 1 in
let pr fmt = let pr fmt =
ksprintf (fun s -> ksprintf (fun s ->

View File

@ -484,7 +484,7 @@ module Scheduler = struct
Hashtbl.fold running ~init:[] ~f:(fun ~key:pid ~data:job acc -> Hashtbl.fold running ~init:[] ~f:(fun ~key:pid ~data:job acc ->
let pid, status = Unix.waitpid [WNOHANG] pid in let pid, status = Unix.waitpid [WNOHANG] pid in
if pid <> 0 then begin if pid <> 0 then begin
(job, status) :: acc (job, status) :: acc
end else end else
acc) acc)
in in
@ -546,7 +546,7 @@ module Scheduler = struct
let get_std_output ~default = function let get_std_output ~default = function
| Terminal -> (default, None) | Terminal -> (default, None)
| File fn -> | 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)) (fd, Some (Fd fd))
| Opened_file { desc; tail; _ } -> | Opened_file { desc; tail; _ } ->
let fd = let fd =
@ -578,7 +578,7 @@ module Scheduler = struct
match job.stdout_to, job.stderr_to with match job.stdout_to, job.stderr_to with
| Terminal, _ | _, Terminal -> | Terminal, _ | _, Terminal ->
let fn = Temp.create "jbuilder" ".output" in 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) (None, Unix.stdin)
in in

View File

@ -1510,7 +1510,7 @@ module Gen(P : Params) = struct
{ m with obj_name = obj_name_of_basename m.impl.name }) { m with obj_name = obj_name_of_basename m.impl.name })
in in
List.iter exes.names ~f:(fun name -> 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" die "executable %s in %s doesn't have a corresponding .ml file"
name (Path.to_string dir)); name (Path.to_string dir));
let modules = let modules =

View File

@ -9,9 +9,6 @@ external reraise : exn -> _ = "%reraise"
(* To make bug reports usable *) (* To make bug reports usable *)
let () = Printexc.record_backtrace true let () = Printexc.record_backtrace true
let open_in = open_in_bin
let open_out = open_out_bin
let sprintf = Printf.sprintf let sprintf = Printf.sprintf
let ksprintf = Printf.ksprintf let ksprintf = Printf.ksprintf
@ -391,11 +388,13 @@ let protectx x ~finally ~f =
| y -> finally x; y | y -> finally x; y
| exception e -> finally x; raise e | exception e -> finally x; raise e
let with_file_in fn ~f = let with_file_in ?(binary=true) fn ~f =
protectx (open_in fn) ~finally:close_in ~f protectx ((if binary then open_in_bin else open_in) fn)
~finally:close_in ~f
let with_file_out fn ~f = let with_file_out ?(binary=true)fn ~f =
protectx (open_out fn) ~finally:close_out ~f protectx ((if binary then open_out_bin else open_out) fn)
~finally:close_out ~f
let with_lexbuf_from_file fn ~f = let with_lexbuf_from_file fn ~f =
with_file_in fn ~f:(fun ic -> with_file_in fn ~f:(fun ic ->
@ -412,16 +411,17 @@ let input_lines =
let rec loop ic acc = let rec loop ic acc =
match input_line ic with match input_line ic with
| exception End_of_file -> List.rev acc | exception End_of_file -> List.rev acc
| line -> loop ic (line :: acc) | line ->
loop ic (line :: acc)
in in
fun ic -> loop ic [] fun ic -> loop ic []
let read_file fn = 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 let len = in_channel_length ic in
really_input_string ic len) 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) let write_file fn data = with_file_out fn ~f:(fun oc -> output_string oc data)

View File

@ -150,6 +150,7 @@ let bootstrap () =
[ "-j" , Set_int Clflags.concurrency, "JOBS concurrency" [ "-j" , Set_int Clflags.concurrency, "JOBS concurrency"
; "--dev" , Set Clflags.dev_mode , " set development mode" ; "--dev" , Set Clflags.dev_mode , " set development mode"
; "--debug-rules", Set Clflags.debug_rules , " print out rules" ; "--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:"; anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:";
let log = Log.create () in let log = Log.create () in