Skip to content

Commit

Permalink
Fix ocaml#1166 by not using Path in configurator
Browse files Browse the repository at this point in the history 
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
  • Loading branch information
@rgrinberg
rgrinberg committed Aug 23, 2018
1 parent 970adeb commit d9515ee
Show file tree
Hide file tree
Showing 4 changed files with 173 additions and 189 deletions.
27 changes: 13 additions & 14 deletions src/configurator/v1.ml
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,10 @@
open! Stdune

(* we shadow this module on purpose because it's unusable without the build dir
initialized *)
module Path = struct end
module Io = Io.String_path

let sprintf = Printf.sprintf
let eprintf = Printf.eprintf

Expand Down Expand Up @@ -69,12 +74,10 @@ module Flags = struct

let extract_blank_separated_words = String.extract_blank_separated_words

let write_lines fname s =
let path = Path.of_string fname in
let write_lines path s =
Io.write_lines path s

let write_sexp fname s =
let path = Path.in_source fname in
let write_sexp path s =
let sexp = Dsexp.List (List.map s ~f:(fun s -> Dsexp.Quoted_string s)) in
Io.write_file path (Dsexp.to_string sexp ~syntax:Dune)
end
Expand Down Expand Up @@ -160,12 +163,8 @@ let run t ~dir cmd =
(Filename.quote stdout_fn)
(Filename.quote stderr_fn)
in
let stdout =
Io.read_file (Path.of_filename_relative_to_initial_cwd stdout_fn)
in
let stderr =
Io.read_file (Path.of_filename_relative_to_initial_cwd stderr_fn)
in
let stdout = Io.read_file stdout_fn in
let stderr = Io.read_file stderr_fn in
logf t "-> process exited with code %d" exit_code;
logf t "-> stdout:";
List.iter (String.split_lines stdout) ~f:(logf t " | %s");
Expand Down Expand Up @@ -259,7 +258,7 @@ let compile_and_link_c_prog t ?(c_flags=[]) ?(link_flags=[]) code =
let c_fname = base ^ ".c" in
let obj_fname = base ^ t.ext_obj in
let exe_fname = base ^ ".exe" in
Io.write_file (Path.of_filename_relative_to_initial_cwd c_fname) code;
Io.write_file c_fname code;
logf t "compiling c program:";
List.iter (String.split_lines code) ~f:(logf t " | %s");
let run_ok args =
Expand Down Expand Up @@ -289,7 +288,7 @@ let compile_c_prog t ?(c_flags=[]) code =
let base = dir ^/ "test" in
let c_fname = base ^ ".c" in
let obj_fname = base ^ t.ext_obj in
Io.write_file (Path.of_filename_relative_to_initial_cwd c_fname) code;
Io.write_file c_fname code;
logf t "compiling c program:";
List.iter (String.split_lines code) ~f:(logf t " | %s");
let run_ok args =
Expand All @@ -307,7 +306,7 @@ let compile_c_prog t ?(c_flags=[]) code =
])
in
if ok then
Ok (Path.of_filename_relative_to_initial_cwd obj_fname)
Ok obj_fname
else
Error ()

Expand Down Expand Up @@ -438,7 +437,7 @@ const char *s%i = "BEGIN-%i-false-END";
logf t "writing header file %s" fname;
List.iter lines ~f:(logf t " | %s");
let tmp_fname = fname ^ ".tmp" in
Io.write_lines (Path.of_filename_relative_to_initial_cwd tmp_fname) lines;
Io.write_lines tmp_fname lines;
Sys.rename tmp_fname fname
end

Expand Down
237 changes: 137 additions & 100 deletions src/stdune/io.ml
View file
Original file line number Diff line number Diff line change
@@ -1,33 +1,8 @@
module P = Pervasives

let open_in ?(binary=true) p =
let fn = Path.to_string p in
if binary then P.open_in_bin fn else P.open_in fn

let open_out ?(binary=true) p =
let fn = Path.to_string p in
if binary then P.open_out_bin fn else P.open_out fn

let close_in = close_in
let close_out = close_out

let with_file_in ?binary fn ~f =
Exn.protectx (open_in ?binary fn) ~finally:close_in ~f

let with_file_out ?binary p ~f =
Exn.protectx (open_out ?binary p) ~finally:close_out ~f

let with_lexbuf_from_file fn ~f =
with_file_in fn ~f:(fun ic ->
let lb = Lexing.from_channel ic in
lb.lex_curr_p <-
{ pos_fname = Path.to_string fn
; pos_lnum = 1
; pos_bol = 0
; pos_cnum = 0
};
f lb)

let input_lines =
let rec loop ic acc =
match input_line ic with
Expand All @@ -37,25 +12,6 @@ let input_lines =
in
fun ic -> loop ic []

let read_all ic =
let len = in_channel_length ic in
really_input_string ic len

let read_file ?binary fn = with_file_in fn ~f:read_all ?binary

let lines_of_file fn = with_file_in fn ~f:input_lines ~binary:false

let write_file ?binary fn data =
with_file_out ?binary fn ~f:(fun oc -> output_string oc data)

let write_lines fn lines =
with_file_out fn ~f:(fun oc ->
List.iter ~f:(fun line ->
output_string oc line;
output_string oc "\n"
) lines
)

let copy_channels =
let buf_len = 65536 in
let buf = Bytes.create buf_len in
Expand All @@ -66,60 +22,141 @@ let copy_channels =
in
loop

let copy_file ?(chmod=fun x -> x) ~src ~dst () =
with_file_in src ~f:(fun ic ->
let perm = (Unix.fstat (Unix.descr_of_in_channel ic)).st_perm |> chmod in
Exn.protectx (P.open_out_gen
[Open_wronly; Open_creat; Open_trunc; Open_binary]
perm
(Path.to_string dst))
~finally:close_out
~f:(fun oc ->
copy_channels ic oc))

let compare_files fn1 fn2 =
let s1 = read_file fn1 in
let s2 = read_file fn2 in
String.compare s1 s2

let read_file_and_normalize_eols fn =
if not Sys.win32 then
read_file fn
else begin
let src = read_file fn in
let len = String.length src in
let dst = Bytes.create len in
let rec find_next_crnl i =
match String.index_from src i '\r' with
| exception Not_found -> None
| j ->
if j + 1 < len && src.[j + 1] = '\n' then
Some j
else
find_next_crnl (j + 1)
in
let rec loop src_pos dst_pos =
match find_next_crnl src_pos with
| None ->
let len =
if len > src_pos && src.[len - 1] = '\r' then
len - 1 - src_pos
module type S = sig
type path

val open_in : ?binary:bool (* default true *) -> path -> in_channel
val open_out : ?binary:bool (* default true *) -> path -> out_channel

val with_file_in : ?binary:bool (* default true *) -> path -> f:(in_channel -> 'a) -> 'a
val with_file_out : ?binary:bool (* default true *) -> path -> f:(out_channel -> 'a) -> 'a

val with_lexbuf_from_file : path -> f:(Lexing.lexbuf -> 'a) -> 'a
val lines_of_file : path -> string list

val read_file : ?binary:bool -> path -> string
val write_file : ?binary:bool -> path -> string -> unit

val compare_files : path -> path -> Ordering.t
val compare_text_files : path -> path -> Ordering.t

val write_lines : path -> string list -> unit
val copy_file : ?chmod:(int -> int) -> src:path -> dst:path -> unit -> unit
end

module Make (Path : sig
type t
val to_string : t -> string
end) = struct

type path = Path.t

let open_in ?(binary=true) p =
let fn = Path.to_string p in
if binary then P.open_in_bin fn else P.open_in fn

let open_out ?(binary=true) p =
let fn = Path.to_string p in
if binary then P.open_out_bin fn else P.open_out fn

let with_file_in ?binary fn ~f =
Exn.protectx (open_in ?binary fn) ~finally:close_in ~f

let with_file_out ?binary p ~f =
Exn.protectx (open_out ?binary p) ~finally:close_out ~f

let with_lexbuf_from_file fn ~f =
with_file_in fn ~f:(fun ic ->
let lb = Lexing.from_channel ic in
lb.lex_curr_p <-
{ pos_fname = Path.to_string fn
; pos_lnum = 1
; pos_bol = 0
; pos_cnum = 0
};
f lb)

let read_all ic =
let len = in_channel_length ic in
really_input_string ic len

let read_file ?binary fn = with_file_in fn ~f:read_all ?binary

let lines_of_file fn = with_file_in fn ~f:input_lines ~binary:false

let write_file ?binary fn data =
with_file_out ?binary fn ~f:(fun oc -> output_string oc data)

let write_lines fn lines =
with_file_out fn ~f:(fun oc ->
List.iter ~f:(fun line ->
output_string oc line;
output_string oc "\n"
) lines
)

let read_file_and_normalize_eols fn =
if not Sys.win32 then
read_file fn
else begin
let src = read_file fn in
let len = String.length src in
let dst = Bytes.create len in
let rec find_next_crnl i =
match String.index_from src i '\r' with
| exception Not_found -> None
| j ->
if j + 1 < len && src.[j + 1] = '\n' then
Some j
else
len - src_pos
in
Bytes.blit_string ~src ~src_pos ~dst ~dst_pos ~len;
Bytes.sub_string dst ~pos:0 ~len:(dst_pos + len)
| Some i ->
let len = i - src_pos in
Bytes.blit_string ~src ~src_pos ~dst ~dst_pos ~len;
let dst_pos = dst_pos + len in
Bytes.set dst dst_pos '\n';
loop (i + 2) (dst_pos + 1)
in
loop 0 0
end

let compare_text_files fn1 fn2 =
let s1 = read_file_and_normalize_eols fn1 in
let s2 = read_file_and_normalize_eols fn2 in
String.compare s1 s2
find_next_crnl (j + 1)
in
let rec loop src_pos dst_pos =
match find_next_crnl src_pos with
| None ->
let len =
if len > src_pos && src.[len - 1] = '\r' then
len - 1 - src_pos
else
len - src_pos
in
Bytes.blit_string ~src ~src_pos ~dst ~dst_pos ~len;
Bytes.sub_string dst ~pos:0 ~len:(dst_pos + len)
| Some i ->
let len = i - src_pos in
Bytes.blit_string ~src ~src_pos ~dst ~dst_pos ~len;
let dst_pos = dst_pos + len in
Bytes.set dst dst_pos '\n';
loop (i + 2) (dst_pos + 1)
in
loop 0 0
end

let compare_text_files fn1 fn2 =
let s1 = read_file_and_normalize_eols fn1 in
let s2 = read_file_and_normalize_eols fn2 in
String.compare s1 s2

let compare_files fn1 fn2 =
let s1 = read_file fn1 in
let s2 = read_file fn2 in
String.compare s1 s2

let copy_file ?(chmod=fun x -> x) ~src ~dst () =
with_file_in src ~f:(fun ic ->
let perm = (Unix.fstat (Unix.descr_of_in_channel ic)).st_perm |> chmod in
Exn.protectx (P.open_out_gen
[Open_wronly; Open_creat; Open_trunc; Open_binary]
perm
(Path.to_string dst))
~finally:close_out
~f:(fun oc ->
copy_channels ic oc))
end

include Make(Path)

module String_path = Make(struct
type t = string
let to_string x = x
end)
39 changes: 23 additions & 16 deletions src/stdune/io.mli
View file
Original file line number Diff line number Diff line change
@@ -1,29 +1,36 @@
(** IO operations *)

val open_in : ?binary:bool (* default true *) -> Path.t -> in_channel
val open_out : ?binary:bool (* default true *) -> Path.t -> out_channel

val close_in : in_channel -> unit
val close_out : out_channel -> unit

val with_file_in : ?binary:bool (* default true *) -> Path.t -> f:(in_channel -> 'a) -> 'a
val with_file_out : ?binary:bool (* default true *) -> Path.t -> f:(out_channel -> 'a) -> 'a
val input_lines : in_channel -> string list

val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a
val copy_channels : in_channel -> out_channel -> unit

val input_lines : in_channel -> string list
val lines_of_file : Path.t -> string list
val read_all : in_channel -> string

val read_file : ?binary:bool -> Path.t -> string
val write_file : ?binary:bool -> Path.t -> string -> unit
module type S = sig
type path

val compare_files : Path.t -> Path.t -> Ordering.t
val compare_text_files : Path.t -> Path.t -> Ordering.t
val open_in : ?binary:bool (* default true *) -> path -> in_channel
val open_out : ?binary:bool (* default true *) -> path -> out_channel

val write_lines : Path.t -> string list -> unit
val with_file_in : ?binary:bool (* default true *) -> path -> f:(in_channel -> 'a) -> 'a
val with_file_out : ?binary:bool (* default true *) -> path -> f:(out_channel -> 'a) -> 'a

val copy_channels : in_channel -> out_channel -> unit
val with_lexbuf_from_file : path -> f:(Lexing.lexbuf -> 'a) -> 'a
val lines_of_file : path -> string list

val copy_file : ?chmod:(int -> int) -> src:Path.t -> dst:Path.t -> unit -> unit
val read_file : ?binary:bool -> path -> string
val write_file : ?binary:bool -> path -> string -> unit

val read_all : in_channel -> string
val compare_files : path -> path -> Ordering.t
val compare_text_files : path -> path -> Ordering.t

val write_lines : path -> string list -> unit
val copy_file : ?chmod:(int -> int) -> src:path -> dst:path -> unit -> unit
end

include S with type path = Path.t

module String_path : S with type path = string
Loading

0 comments on commit d9515ee

Please sign in to comment.