From d522acb1e85742b59ff7ee15a347a8899006ad1e Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 22 Aug 2018 13:28:01 +0300 Subject: [PATCH 1/3] Add test case to show regression 1166 Signed-off-by: Rudi Grinberg --- test/blackbox-tests/dune.inc | 10 ++++ .../configurator-gh1166/discover.ml | 4 ++ .../test-cases/configurator-gh1166/dune | 4 ++ .../configurator-gh1166/dune-project | 1 + .../test-cases/configurator-gh1166/run.t | 60 +++++++++++++++++++ 5 files changed, 79 insertions(+) create mode 100644 test/blackbox-tests/test-cases/configurator-gh1166/discover.ml create mode 100644 test/blackbox-tests/test-cases/configurator-gh1166/dune create mode 100644 test/blackbox-tests/test-cases/configurator-gh1166/dune-project create mode 100644 test/blackbox-tests/test-cases/configurator-gh1166/run.t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 58cfaa8a..e9af82f5 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -55,6 +55,14 @@ (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))) (enabled_if (<> %{ocaml-config:system} win))) +(alias + (name configurator-gh1166) + (deps (package dune) (source_tree test-cases/configurator-gh1166)) + (action + (chdir + test-cases/configurator-gh1166 + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name copy_files) (deps (package dune) (source_tree test-cases/copy_files)) @@ -822,6 +830,7 @@ (alias byte-code-only) (alias c-stubs) (alias configurator) + (alias configurator-gh1166) (alias copy_files) (alias cross-compilation) (alias custom-build-dir) @@ -923,6 +932,7 @@ (alias byte-code-only) (alias c-stubs) (alias configurator) + (alias configurator-gh1166) (alias copy_files) (alias cross-compilation) (alias custom-build-dir) diff --git a/test/blackbox-tests/test-cases/configurator-gh1166/discover.ml b/test/blackbox-tests/test-cases/configurator-gh1166/discover.ml new file mode 100644 index 00000000..3d2b7595 --- /dev/null +++ b/test/blackbox-tests/test-cases/configurator-gh1166/discover.ml @@ -0,0 +1,4 @@ +let () = + let module C = Configurator.V1 in + C.main ~name:"foo" (fun _c -> + C.Flags.write_lines "foo" ["asdf"]) diff --git a/test/blackbox-tests/test-cases/configurator-gh1166/dune b/test/blackbox-tests/test-cases/configurator-gh1166/dune new file mode 100644 index 00000000..1204aa36 --- /dev/null +++ b/test/blackbox-tests/test-cases/configurator-gh1166/dune @@ -0,0 +1,4 @@ +(executable + (name discover) + (modules discover) + (libraries dune.configurator)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/configurator-gh1166/dune-project b/test/blackbox-tests/test-cases/configurator-gh1166/dune-project new file mode 100644 index 00000000..6687faf2 --- /dev/null +++ b/test/blackbox-tests/test-cases/configurator-gh1166/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/configurator-gh1166/run.t b/test/blackbox-tests/test-cases/configurator-gh1166/run.t new file mode 100644 index 00000000..2098607d --- /dev/null +++ b/test/blackbox-tests/test-cases/configurator-gh1166/run.t @@ -0,0 +1,60 @@ + $ dune exec ./discover.exe + run: /Users/rgrinberg/.opam/4.06.1/bin/ocamlc.opt -config + -> process exited with code 0 + -> stdout: + | version: 4.06.1 + | standard_library_default: /Users/rgrinberg/.opam/4.06.1/lib/ocaml + | standard_library: /Users/rgrinberg/.opam/4.06.1/lib/ocaml + | standard_runtime: /Users/rgrinberg/.opam/4.06.1/bin/ocamlrun + | ccomp_type: cc + | c_compiler: cc + | ocamlc_cflags: -O2 -fno-strict-aliasing -fwrapv + | ocamlc_cppflags: -D_FILE_OFFSET_BITS=64 -D_REENTRANT + | ocamlopt_cflags: -O2 -fno-strict-aliasing -fwrapv + | ocamlopt_cppflags: -D_FILE_OFFSET_BITS=64 -D_REENTRANT + | bytecomp_c_compiler: cc -O2 -fno-strict-aliasing -fwrapv -D_FILE_OFFSET_BITS=64 -D_REENTRANT + | native_c_compiler: cc -O2 -fno-strict-aliasing -fwrapv -D_FILE_OFFSET_BITS=64 -D_REENTRANT + | bytecomp_c_libraries: -lcurses -lpthread + | native_c_libraries: + | native_pack_linker: ld -r -o + | ranlib: ranlib + | cc_profile: -pg + | architecture: amd64 + | model: default + | int_size: 63 + | word_size: 64 + | system: macosx + | asm: clang -arch x86_64 -Wno-trigraphs -c + | asm_cfi_supported: true + | with_frame_pointers: false + | ext_exe: + | ext_obj: $ext_obj + | ext_asm: $ext_asm + | ext_lib: $ext_lib + | ext_dll: $ext_dll + | os_type: Unix + | default_executable_name: a.out + | systhread_supported: true + | host: x86_64-apple-darwin17.5.0 + | target: x86_64-apple-darwin17.5.0 + | profiling: true + | flambda: false + | spacetime: false + | safe_string: false + | default_safe_string: true + | flat_float_array: true + | afl_instrument: false + | windows_unicode: false + | exec_magic_number: Caml1999X011 + | cmi_magic_number: Caml1999I022 + | cmo_magic_number: Caml1999O022 + | cma_magic_number: Caml1999A022 + | cmx_magic_number: Caml1999Y022 + | cmxa_magic_number: Caml1999Z022 + | ast_impl_magic_number: Caml1999M022 + | ast_intf_magic_number: Caml1999N022 + | cmxs_magic_number: Caml1999D022 + | cmt_magic_number: Caml1999T022 + -> stderr: + Fatal error: exception Stdune__Exn.Code_error(_) + [2] From 72c322d75bc4f440ba7a3d9861ede8478e8a2545 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 23 Aug 2018 21:07:44 +0300 Subject: [PATCH 2/3] Fix #1166 by not using Path in configurator Signed-off-by: Rudi Grinberg --- src/configurator/v1.ml | 27 +- src/stdune/io.ml | 231 ++++++++++-------- src/stdune/io.mli | 45 ++-- .../test-cases/configurator-gh1166/run.t | 59 ----- 4 files changed, 173 insertions(+), 189 deletions(-) diff --git a/src/configurator/v1.ml b/src/configurator/v1.ml index 398b49b9..6618525e 100644 --- a/src/configurator/v1.ml +++ b/src/configurator/v1.ml @@ -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 @@ -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 @@ -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"); @@ -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 = @@ -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 = @@ -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 () @@ -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 diff --git a/src/stdune/io.ml b/src/stdune/io.ml index ac655ba3..6d1e190b 100644 --- a/src/stdune/io.ml +++ b/src/stdune/io.ml @@ -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 @@ -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 @@ -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)) +module type S = sig + type path -let compare_files fn1 fn2 = - let s1 = read_file fn1 in - let s2 = read_file fn2 in - String.compare s1 s2 + val open_in : ?binary:bool (* default true *) -> path -> in_channel + val open_out : ?binary:bool (* default true *) -> path -> out_channel -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 + 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 + 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_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) diff --git a/src/stdune/io.mli b/src/stdune/io.mli index 9c767804..89fe5981 100644 --- a/src/stdune/io.mli +++ b/src/stdune/io.mli @@ -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 with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a - val input_lines : in_channel -> string list -val lines_of_file : Path.t -> string list - -val read_file : ?binary:bool -> Path.t -> string -val write_file : ?binary:bool -> Path.t -> string -> unit - -val compare_files : Path.t -> Path.t -> Ordering.t -val compare_text_files : Path.t -> Path.t -> Ordering.t - -val write_lines : Path.t -> string list -> unit val copy_channels : in_channel -> out_channel -> unit -val copy_file : ?chmod:(int -> int) -> src:Path.t -> dst:Path.t -> unit -> unit - val read_all : in_channel -> string + +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 + +include S with type path = Path.t + +module String_path : S with type path = string diff --git a/test/blackbox-tests/test-cases/configurator-gh1166/run.t b/test/blackbox-tests/test-cases/configurator-gh1166/run.t index 2098607d..6197eec7 100644 --- a/test/blackbox-tests/test-cases/configurator-gh1166/run.t +++ b/test/blackbox-tests/test-cases/configurator-gh1166/run.t @@ -1,60 +1 @@ $ dune exec ./discover.exe - run: /Users/rgrinberg/.opam/4.06.1/bin/ocamlc.opt -config - -> process exited with code 0 - -> stdout: - | version: 4.06.1 - | standard_library_default: /Users/rgrinberg/.opam/4.06.1/lib/ocaml - | standard_library: /Users/rgrinberg/.opam/4.06.1/lib/ocaml - | standard_runtime: /Users/rgrinberg/.opam/4.06.1/bin/ocamlrun - | ccomp_type: cc - | c_compiler: cc - | ocamlc_cflags: -O2 -fno-strict-aliasing -fwrapv - | ocamlc_cppflags: -D_FILE_OFFSET_BITS=64 -D_REENTRANT - | ocamlopt_cflags: -O2 -fno-strict-aliasing -fwrapv - | ocamlopt_cppflags: -D_FILE_OFFSET_BITS=64 -D_REENTRANT - | bytecomp_c_compiler: cc -O2 -fno-strict-aliasing -fwrapv -D_FILE_OFFSET_BITS=64 -D_REENTRANT - | native_c_compiler: cc -O2 -fno-strict-aliasing -fwrapv -D_FILE_OFFSET_BITS=64 -D_REENTRANT - | bytecomp_c_libraries: -lcurses -lpthread - | native_c_libraries: - | native_pack_linker: ld -r -o - | ranlib: ranlib - | cc_profile: -pg - | architecture: amd64 - | model: default - | int_size: 63 - | word_size: 64 - | system: macosx - | asm: clang -arch x86_64 -Wno-trigraphs -c - | asm_cfi_supported: true - | with_frame_pointers: false - | ext_exe: - | ext_obj: $ext_obj - | ext_asm: $ext_asm - | ext_lib: $ext_lib - | ext_dll: $ext_dll - | os_type: Unix - | default_executable_name: a.out - | systhread_supported: true - | host: x86_64-apple-darwin17.5.0 - | target: x86_64-apple-darwin17.5.0 - | profiling: true - | flambda: false - | spacetime: false - | safe_string: false - | default_safe_string: true - | flat_float_array: true - | afl_instrument: false - | windows_unicode: false - | exec_magic_number: Caml1999X011 - | cmi_magic_number: Caml1999I022 - | cmo_magic_number: Caml1999O022 - | cma_magic_number: Caml1999A022 - | cmx_magic_number: Caml1999Y022 - | cmxa_magic_number: Caml1999Z022 - | ast_impl_magic_number: Caml1999M022 - | ast_intf_magic_number: Caml1999N022 - | cmxs_magic_number: Caml1999D022 - | cmt_magic_number: Caml1999T022 - -> stderr: - Fatal error: exception Stdune__Exn.Code_error(_) - [2] From dc2097076381084467a8afbfcc06f43ee067d062 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 23 Aug 2018 21:09:54 +0300 Subject: [PATCH 3/3] Update CHANGES Signed-off-by: Rudi Grinberg --- CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 7db7b136..77872a32 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -24,6 +24,9 @@ next - Do no try to generate shared libraries when this is not supported by the OS (#1165, fix #1051, @diml) +- Fix `Flags.write_{sexp,lines}` in configurator by avoiding the use of + `Stdune.Path` (#1175, fix #1161, @rgrinberg) + 1.1.1 (08/08/2018) ------------------