Refactor IO functions and fix invalid IOs in gen_rules
This commit is contained in:
parent
9df1bad58c
commit
a3ee81055d
|
@ -302,13 +302,13 @@ module Mini_shexp = struct
|
|||
| None -> print_string str; flush stdout
|
||||
| Some (_, oc) -> output_string oc str)
|
||||
| Cat fn ->
|
||||
with_file_in (Path.to_string fn) ~f:(fun ic ->
|
||||
Io.with_file_in (Path.to_string fn) ~f:(fun ic ->
|
||||
let oc =
|
||||
match stdout_to with
|
||||
| None -> stdout
|
||||
| Some (_, oc) -> oc
|
||||
in
|
||||
copy_channels ic oc);
|
||||
Io.copy_channels ic oc);
|
||||
return ()
|
||||
| Create_file fn ->
|
||||
let fn = Path.to_string fn in
|
||||
|
@ -316,11 +316,11 @@ module Mini_shexp = struct
|
|||
Unix.close (Unix.openfile fn [O_CREAT; O_TRUNC; O_WRONLY] 0o666);
|
||||
return ()
|
||||
| Copy (src, dst) ->
|
||||
copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst);
|
||||
Io.copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst);
|
||||
return ()
|
||||
| Symlink (src, dst) ->
|
||||
if Sys.win32 then
|
||||
copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst)
|
||||
Io.copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst)
|
||||
else begin
|
||||
let src =
|
||||
if Path.is_root dst then
|
||||
|
@ -340,11 +340,11 @@ module Mini_shexp = struct
|
|||
end;
|
||||
return ()
|
||||
| Copy_and_add_line_directive (src, dst) ->
|
||||
with_file_in (Path.to_string src) ~f:(fun ic ->
|
||||
with_file_out (Path.to_string dst) ~f:(fun oc ->
|
||||
Io.with_file_in (Path.to_string src) ~f:(fun ic ->
|
||||
Io.with_file_out (Path.to_string dst) ~f:(fun oc ->
|
||||
let fn = Path.drop_build_context src in
|
||||
Printf.fprintf oc "# 1 %S\n" (Path.to_string fn);
|
||||
copy_channels ic oc));
|
||||
Io.copy_channels ic oc));
|
||||
return ()
|
||||
| System cmd ->
|
||||
let path, arg =
|
||||
|
@ -357,10 +357,10 @@ module Mini_shexp = struct
|
|||
["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd]
|
||||
| Update_file (fn, s) ->
|
||||
let fn = Path.to_string fn in
|
||||
if Sys.file_exists fn && read_file fn = s then
|
||||
if Sys.file_exists fn && Io.read_file fn = s then
|
||||
()
|
||||
else
|
||||
write_file fn s;
|
||||
Io.write_file fn s;
|
||||
return ()
|
||||
| Rename (src, dst) ->
|
||||
Unix.rename (Path.to_string src) (Path.to_string dst);
|
||||
|
@ -368,7 +368,7 @@ module Mini_shexp = struct
|
|||
|
||||
and redirect outputs fn t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
||||
let fn = Path.to_string fn in
|
||||
let oc = open_out_bin fn in
|
||||
let oc = Io.open_out fn in
|
||||
let out = Some (fn, oc) in
|
||||
let stdout_to, stderr_to =
|
||||
match outputs with
|
||||
|
|
|
@ -237,8 +237,8 @@ module Build_exec = struct
|
|||
(a, b)
|
||||
| Paths _ -> x
|
||||
| Paths_glob _ -> x
|
||||
| Contents p -> read_file (Path.to_string p)
|
||||
| Lines_of p -> lines_of_file (Path.to_string p)
|
||||
| Contents p -> Io.read_file (Path.to_string p)
|
||||
| Lines_of p -> Io.lines_of_file (Path.to_string p)
|
||||
| Vpath (Vspec.T (fn, kind)) ->
|
||||
let file : b File_spec.t = get_file bs fn (Sexp_file kind) in
|
||||
Option.value_exn file.data
|
||||
|
@ -524,12 +524,12 @@ module Trace = struct
|
|||
Sexp.List [ Atom (Path.to_string path); Atom (Digest.to_hex hash) ]))
|
||||
in
|
||||
if Sys.file_exists "_build" then
|
||||
write_file file (Sexp.to_string sexp)
|
||||
Io.write_file file (Sexp.to_string sexp)
|
||||
|
||||
let load () =
|
||||
let trace = Hashtbl.create 1024 in
|
||||
if Sys.file_exists file then begin
|
||||
let sexp = Sexp_load.single file in
|
||||
let sexp = Sexp_lexer.Load.single file in
|
||||
let bindings =
|
||||
let open Sexp.Of_sexp in
|
||||
list (pair Path.t (fun s -> Digest.from_hex (string s))) sexp
|
||||
|
|
|
@ -118,7 +118,7 @@ let compare a b = compare a.name b.name
|
|||
|
||||
let get_arch_sixtyfour stdlib_dir =
|
||||
let config_h = Path.relative stdlib_dir "caml/config.h" in
|
||||
List.exists (lines_of_file (Path.to_string config_h)) ~f:(fun line ->
|
||||
List.exists (Io.lines_of_file (Path.to_string config_h)) ~f:(fun line ->
|
||||
match String.extract_blank_separated_words line with
|
||||
| ["#define"; "ARCH_SIXTYFOUR"] -> true
|
||||
| _ -> false)
|
||||
|
|
|
@ -245,12 +245,12 @@ let run_capture_gen ?dir ?env ?(purpose=Internal_job) fail_mode prog args ~f =
|
|||
Temp.destroy fn;
|
||||
x)
|
||||
|
||||
let run_capture = run_capture_gen ~f:read_file
|
||||
let run_capture_lines = run_capture_gen ~f:lines_of_file
|
||||
let run_capture = run_capture_gen ~f:Io.read_file
|
||||
let run_capture_lines = run_capture_gen ~f:Io.lines_of_file
|
||||
|
||||
let run_capture_line ?dir ?env ?(purpose=Internal_job) fail_mode prog args =
|
||||
run_capture_gen ?dir ?env ~purpose fail_mode prog args ~f:(fun fn ->
|
||||
match lines_of_file fn with
|
||||
match Io.lines_of_file fn with
|
||||
| [x] -> x
|
||||
| l ->
|
||||
let cmdline =
|
||||
|
@ -414,7 +414,7 @@ module Scheduler = struct
|
|||
match job.output_filename with
|
||||
| None -> ""
|
||||
| Some fn ->
|
||||
let s = read_file fn in
|
||||
let s = Io.read_file fn in
|
||||
Temp.destroy fn;
|
||||
let len = String.length s in
|
||||
if len > 0 && s.[len - 1] <> '\n' then
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
open Import
|
||||
open Jbuild_types
|
||||
open Build.O
|
||||
open! No_io
|
||||
|
||||
(* +-----------------------------------------------------------------+
|
||||
| Utils |
|
||||
|
@ -666,21 +667,22 @@ module Gen(P : Params) = struct
|
|||
match pkg.version_from_opam_file with
|
||||
| Some s -> Build.return (Some s)
|
||||
| None ->
|
||||
let candicates =
|
||||
let rec loop = function
|
||||
| [] -> Build.return None
|
||||
| candidate :: rest ->
|
||||
let p = Path.relative path candidate in
|
||||
Build.if_file_exists p
|
||||
~then_:(Build.lines_of p
|
||||
>>^ function
|
||||
| ver :: _ -> Some ver
|
||||
| _ -> Some "")
|
||||
~else_:(loop rest)
|
||||
in
|
||||
loop
|
||||
[ pkg.name ^ ".version"
|
||||
; "version"
|
||||
; "VERSION"
|
||||
]
|
||||
in
|
||||
match List.find candicates ~f:(fun fn -> String_set.mem fn files) with
|
||||
| None -> Build.return None
|
||||
| Some fn ->
|
||||
let p = Path.relative path fn in
|
||||
Build.path p
|
||||
>>^ fun () ->
|
||||
match lines_of_file (Path.to_string p) with
|
||||
| ver :: _ -> Some ver
|
||||
| _ -> Some ""
|
||||
in
|
||||
Super_context.Pkg_version.set sctx pkg get
|
||||
in
|
||||
|
|
|
@ -397,43 +397,6 @@ let protectx x ~finally ~f =
|
|||
| y -> finally x; y
|
||||
| exception e -> finally x; raise e
|
||||
|
||||
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 ?(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 ->
|
||||
let lb = Lexing.from_channel ic in
|
||||
lb.lex_curr_p <-
|
||||
{ pos_fname = 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
|
||||
| exception End_of_file -> List.rev acc
|
||||
| line ->
|
||||
loop ic (line :: acc)
|
||||
in
|
||||
fun ic -> loop ic []
|
||||
|
||||
let read_file fn =
|
||||
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 ~binary:false
|
||||
|
||||
let write_file fn data = with_file_out fn ~f:(fun oc -> output_string oc data)
|
||||
|
||||
exception Fatal_error of string
|
||||
let die_buf = Buffer.create 128
|
||||
let die_ppf (* Referenced in Ansi_color *) = Format.formatter_of_buffer die_buf
|
||||
|
@ -451,27 +414,6 @@ let warn fmt =
|
|||
prerr_endline ("Warning: jbuild: " ^ msg))
|
||||
fmt
|
||||
|
||||
let copy_channels =
|
||||
let buf_len = 65536 in
|
||||
let buf = Bytes.create buf_len in
|
||||
let rec loop ic oc =
|
||||
match input ic buf 0 buf_len with
|
||||
| 0 -> ()
|
||||
| n -> output oc buf 0 n; loop ic oc
|
||||
in
|
||||
loop
|
||||
|
||||
let copy_file ~src ~dst =
|
||||
with_file_in src ~f:(fun ic ->
|
||||
let perm = (Unix.fstat (Unix.descr_of_in_channel ic)).st_perm in
|
||||
protectx (open_out_gen
|
||||
[Open_wronly; Open_creat; Open_trunc; Open_binary]
|
||||
perm
|
||||
dst)
|
||||
~finally:close_out
|
||||
~f:(fun oc ->
|
||||
copy_channels ic oc))
|
||||
|
||||
module Staged : sig
|
||||
type +'a t
|
||||
val unstage : 'a t -> 'a
|
||||
|
@ -516,3 +458,17 @@ let hint name candidates =
|
|||
| [] -> ""
|
||||
in
|
||||
sprintf "\nHint: did you mean %s?" (mk_hint l)
|
||||
|
||||
(* Disable file operations to force to use the IO module *)
|
||||
let open_in = `Use_Io
|
||||
let open_in_bin = `Use_Io
|
||||
let open_in_gen = `Use_Io
|
||||
let open_out = `Use_Io
|
||||
let open_out_bin = `Use_Io
|
||||
let open_out_gen = `Use_Io
|
||||
|
||||
(* We open this module at the top of module generating rules, to make sure they don't do
|
||||
Io manually *)
|
||||
module No_io = struct
|
||||
module Io = struct end
|
||||
end
|
||||
|
|
|
@ -0,0 +1,68 @@
|
|||
open Import
|
||||
|
||||
module P = Pervasives
|
||||
|
||||
let open_in ?(binary=true) fn =
|
||||
if binary then P.open_in_bin fn else P.open_in fn
|
||||
|
||||
let open_out ?(binary=true) fn =
|
||||
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 =
|
||||
protectx (open_in ?binary fn) ~finally:close_in ~f
|
||||
|
||||
let with_file_out ?binary fn ~f =
|
||||
protectx (open_out ?binary fn) ~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 = 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
|
||||
| exception End_of_file -> List.rev acc
|
||||
| line ->
|
||||
loop ic (line :: acc)
|
||||
in
|
||||
fun ic -> loop ic []
|
||||
|
||||
let read_file fn =
|
||||
with_file_in fn ~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 ~binary:false
|
||||
|
||||
let write_file fn data = with_file_out fn ~f:(fun oc -> output_string oc data)
|
||||
|
||||
let copy_channels =
|
||||
let buf_len = 65536 in
|
||||
let buf = Bytes.create buf_len in
|
||||
let rec loop ic oc =
|
||||
match input ic buf 0 buf_len with
|
||||
| 0 -> ()
|
||||
| n -> output oc buf 0 n; loop ic oc
|
||||
in
|
||||
loop
|
||||
|
||||
let copy_file ~src ~dst =
|
||||
with_file_in src ~f:(fun ic ->
|
||||
let perm = (Unix.fstat (Unix.descr_of_in_channel ic)).st_perm in
|
||||
protectx (P.open_out_gen
|
||||
[Open_wronly; Open_creat; Open_trunc; Open_binary]
|
||||
perm
|
||||
dst)
|
||||
~finally:close_out
|
||||
~f:(fun oc ->
|
||||
copy_channels ic oc))
|
|
@ -0,0 +1,21 @@
|
|||
(** IO operations *)
|
||||
|
||||
val open_in : ?binary:bool (* default true *) -> string -> in_channel
|
||||
val open_out : ?binary:bool (* default true *) -> string -> out_channel
|
||||
|
||||
val close_in : in_channel -> unit
|
||||
val close_out : out_channel -> unit
|
||||
|
||||
val with_file_in : ?binary:bool (* default true *) -> string -> f:(in_channel -> 'a) -> 'a
|
||||
val with_file_out : ?binary:bool (* default true *) -> string -> f:(out_channel -> 'a) -> 'a
|
||||
|
||||
val with_lexbuf_from_file : string -> f:(Lexing.lexbuf -> 'a) -> 'a
|
||||
|
||||
val lines_of_file : string -> string list
|
||||
|
||||
val read_file : string -> string
|
||||
val write_file : string -> string -> unit
|
||||
|
||||
val copy_channels : in_channel -> out_channel -> unit
|
||||
|
||||
val copy_file : src:string -> dst:string -> unit
|
|
@ -31,8 +31,8 @@ module Jbuilds = struct
|
|||
|
||||
let create_plugin_wrapper (context : Context.t) ~exec_dir ~plugin ~wrapper ~target =
|
||||
let plugin = Path.to_string plugin in
|
||||
let plugin_contents = read_file plugin in
|
||||
with_file_out (Path.to_string wrapper) ~f:(fun oc ->
|
||||
let plugin_contents = Io.read_file plugin in
|
||||
Io.with_file_out (Path.to_string wrapper) ~f:(fun oc ->
|
||||
Printf.fprintf oc {|
|
||||
let () = Hashtbl.add Toploop.directive_table "require" (Toploop.Directive_string ignore)
|
||||
module Jbuild_plugin = struct
|
||||
|
@ -117,7 +117,7 @@ end
|
|||
die "@{<error>Error:@} %s failed to produce a valid jbuild file.\n\
|
||||
Did you forgot to call [Jbuild_plugin.V*.send]?"
|
||||
(Path.to_string file);
|
||||
let sexps = Sexp_load.many (Path.to_string generated_jbuild) in
|
||||
let sexps = Sexp_lexer.Load.many (Path.to_string generated_jbuild) in
|
||||
return (dir, pkgs_ctx, Stanzas.parse pkgs_ctx sexps))
|
||||
|> Future.all
|
||||
end
|
||||
|
@ -132,7 +132,7 @@ type conf =
|
|||
let load ~dir ~visible_packages ~closest_packages =
|
||||
let file = Path.relative dir "jbuild" in
|
||||
let pkgs = { Pkgs. visible_packages; closest_packages } in
|
||||
match Sexp_load.many_or_ocaml_script (Path.to_string file) with
|
||||
match Sexp_lexer.Load.many_or_ocaml_script (Path.to_string file) with
|
||||
| Sexps sexps ->
|
||||
Jbuilds.Literal (dir, pkgs, Stanzas.parse pkgs sexps)
|
||||
| Ocaml_script ->
|
||||
|
@ -164,7 +164,7 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () =
|
|||
if String_set.mem "jbuild-ignore" files then
|
||||
let ignore_set =
|
||||
String_set.of_list
|
||||
(lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
|
||||
(Io.lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
|
||||
in
|
||||
Dont_recurse_in
|
||||
(ignore_set,
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
open Import
|
||||
open! No_io
|
||||
|
||||
module SC = Super_context
|
||||
|
||||
|
|
|
@ -13,7 +13,7 @@ let no_log = None
|
|||
let create () =
|
||||
if not (Sys.file_exists "_build") then
|
||||
Unix.mkdir "_build" 0o777;
|
||||
let oc = open_out_bin "_build/log" in
|
||||
let oc = Io.open_out "_build/log" in
|
||||
Printf.fprintf oc "# %s\n%!"
|
||||
(String.concat (List.map (Array.to_list Sys.argv) ~f:quote_for_shell) ~sep:" ");
|
||||
let buf = Buffer.create 1024 in
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
open Import
|
||||
open Build.O
|
||||
open! No_io
|
||||
|
||||
module SC = Super_context
|
||||
|
||||
|
|
|
@ -103,7 +103,7 @@ module Parse = struct
|
|||
end
|
||||
|
||||
let load fn =
|
||||
with_lexbuf_from_file fn ~f:(fun lb ->
|
||||
Io.with_lexbuf_from_file fn ~f:(fun lb ->
|
||||
Parse.entries lb 0 [])
|
||||
|
||||
module Simplified = struct
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
open Import
|
||||
open Build.O
|
||||
open! No_io
|
||||
|
||||
module SC = Super_context
|
||||
|
||||
|
|
|
@ -5,7 +5,7 @@ open OpamParserTypes
|
|||
type t = opamfile
|
||||
|
||||
let load fn =
|
||||
with_lexbuf_from_file fn ~f:(fun lb ->
|
||||
Io.with_lexbuf_from_file fn ~f:(fun lb ->
|
||||
try
|
||||
OpamBaseParser.main OpamLexer.token lb fn
|
||||
with
|
||||
|
|
|
@ -6,3 +6,9 @@ type sexps_or_ocaml_script =
|
|||
| Ocaml_script
|
||||
|
||||
val many_or_ocaml_script : Lexing.lexbuf -> sexps_or_ocaml_script
|
||||
|
||||
module Load : sig
|
||||
val single : string -> Sexp.Ast.t
|
||||
val many : string -> Sexp.Ast.t list
|
||||
val many_or_ocaml_script : string -> sexps_or_ocaml_script
|
||||
end
|
||||
|
|
|
@ -202,4 +202,15 @@ and is_ocaml_script = parse
|
|||
match is_ocaml_script lexbuf with
|
||||
| true -> Ocaml_script
|
||||
| false -> Sexps (many lexbuf)
|
||||
|
||||
module Load = struct
|
||||
let single fn =
|
||||
Io.with_lexbuf_from_file fn ~f:single
|
||||
|
||||
let many fn =
|
||||
Io.with_lexbuf_from_file fn ~f:many
|
||||
|
||||
let many_or_ocaml_script fn =
|
||||
Io.with_lexbuf_from_file fn ~f:many_or_ocaml_script
|
||||
end
|
||||
}
|
||||
|
|
|
@ -1,10 +0,0 @@
|
|||
open Import
|
||||
|
||||
let single fn =
|
||||
with_lexbuf_from_file fn ~f:Sexp_lexer.single
|
||||
|
||||
let many fn =
|
||||
with_lexbuf_from_file fn ~f:Sexp_lexer.many
|
||||
|
||||
let many_or_ocaml_script fn =
|
||||
with_lexbuf_from_file fn ~f:Sexp_lexer.many_or_ocaml_script
|
|
@ -1,5 +0,0 @@
|
|||
open! Import
|
||||
|
||||
val single : string -> Sexp.Ast.t
|
||||
val many : string -> Sexp.Ast.t list
|
||||
val many_or_ocaml_script : string -> Sexp_lexer.sexps_or_ocaml_script
|
|
@ -55,7 +55,7 @@ struct
|
|||
let to_string path x = To_sexp.t path x |> Sexp.to_string
|
||||
|
||||
let load path =
|
||||
Of_sexp.t path (Sexp_load.single (Path.to_string path))
|
||||
Of_sexp.t path (Sexp_lexer.Load.single (Path.to_string path))
|
||||
end
|
||||
|
||||
|
||||
|
|
|
@ -154,7 +154,7 @@ let subst_string s ~fname ~map =
|
|||
Some (Buffer.contents buf)
|
||||
|
||||
let subst_file fn ~map =
|
||||
let s = read_file fn in
|
||||
let s = Io.read_file fn in
|
||||
let s =
|
||||
if Filename.dirname fn = "." && String.is_suffix fn ~suffix:".opam" then
|
||||
"version: \"%%" ^ "VERSION_NUM" ^ "%%\"\n" ^ s
|
||||
|
@ -163,7 +163,7 @@ let subst_file fn ~map =
|
|||
in
|
||||
match subst_string s ~map ~fname:fn with
|
||||
| None -> ()
|
||||
| Some s -> write_file fn s
|
||||
| Some s -> Io.write_file fn s
|
||||
|
||||
let get_name ~files ?name () =
|
||||
let package_names =
|
||||
|
|
|
@ -78,4 +78,4 @@ let t sexps =
|
|||
; contexts = List.rev contexts
|
||||
}
|
||||
|
||||
let load fn = t (Sexp_load.many fn)
|
||||
let load fn = t (Sexp_lexer.Load.many fn)
|
||||
|
|
Loading…
Reference in New Issue