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:
parent
52b326ab43
commit
229e7fa883
|
@ -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 ->
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue