Fix jbuilder rule in case of missing binaries (#292)
Make jbuilder rules work even when binaries are missing * Proper error messages for missing binaries * Unify Prog_spec and Maybe_prog both can simply be unified into a path type that has a hint for the error * Remove scarcely useful in_the_tree parameter It's always true except for the C compiler. In which case, there's no harm in making it true. * Make Artifacts return Action.Prog The old return value was simply converted to this anyway. It's simpler to just return the proper error straight up. * Remove remains of in_the_tree
This commit is contained in:
parent
9c8ecc9fbc
commit
a57c488dd7
|
@ -128,14 +128,35 @@ module Make_mapper
|
|||
| Digest_files x -> Digest_files (List.map x ~f:f_path)
|
||||
end
|
||||
|
||||
module Prog = struct
|
||||
module Not_found = struct
|
||||
type t =
|
||||
{ context : string
|
||||
; program : string
|
||||
; hint : string option
|
||||
}
|
||||
|
||||
let raise { context ; program ; hint } =
|
||||
Utils.program_not_found ?hint ~context program
|
||||
end
|
||||
|
||||
type t = (Path.t, Not_found.t) result
|
||||
|
||||
let t sexp = Ok (Path.t sexp)
|
||||
|
||||
let sexp_of_t = function
|
||||
| Ok s -> Path.sexp_of_t s
|
||||
| Error (e : Not_found.t) -> Sexp.To_sexp.string e.program
|
||||
end
|
||||
|
||||
module type Ast = Action_intf.Ast
|
||||
with type program = Path.t
|
||||
with type program = Prog.t
|
||||
with type path = Path.t
|
||||
with type string = String.t
|
||||
module rec Ast : Ast = Ast
|
||||
|
||||
include Make_ast
|
||||
(Path)
|
||||
(Prog)
|
||||
(Path)
|
||||
(struct
|
||||
type t = string
|
||||
|
@ -169,8 +190,8 @@ module Unresolved = struct
|
|||
let resolve t ~f =
|
||||
map t ~f_path:(fun x -> x) ~f_string:(fun x -> x)
|
||||
~f_program:(function
|
||||
| This p -> p
|
||||
| Search s -> f s)
|
||||
| This p -> Ok p
|
||||
| Search s -> Ok (f s))
|
||||
end
|
||||
|
||||
module Var_expansion = struct
|
||||
|
@ -519,7 +540,9 @@ let exec_echo stdout_to str =
|
|||
|
||||
let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
|
||||
match t with
|
||||
| Run (prog, args) ->
|
||||
| Run (Error e, _) ->
|
||||
Prog.Not_found.raise e
|
||||
| Run (Ok prog, args) ->
|
||||
run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args
|
||||
| Chdir (dir, t) ->
|
||||
exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to
|
||||
|
@ -657,7 +680,10 @@ let sandbox t ~sandboxed ~deps ~targets =
|
|||
Some (Ast.Symlink (path, sandboxed path))
|
||||
else
|
||||
None))
|
||||
; map t ~f_string:(fun x -> x) ~f_path:sandboxed ~f_program:sandboxed
|
||||
; map t ~f_string:(fun x -> x) ~f_path:sandboxed
|
||||
~f_program:(function
|
||||
| Ok p -> Ok (sandboxed p)
|
||||
| Error _ as e -> e)
|
||||
; Progn (List.filter_map targets ~f:(fun path ->
|
||||
if Path.is_local path then
|
||||
Some (Ast.Rename (sandboxed path, path))
|
||||
|
@ -680,7 +706,8 @@ module Infer = struct
|
|||
|
||||
let rec infer acc t =
|
||||
match t with
|
||||
| Run (prog, _) -> acc +< prog
|
||||
| Run (Ok prog, _) -> acc +< prog
|
||||
| Run (Error _, _) -> acc
|
||||
| Redirect (_, fn, t) -> infer (acc +@ fn) t
|
||||
| Cat fn -> acc +< fn
|
||||
| Write_file (fn, _) -> acc +@ fn
|
||||
|
|
|
@ -14,8 +14,24 @@ end
|
|||
|
||||
module Outputs : module type of struct include Action_intf.Outputs end
|
||||
|
||||
(** result of the lookup of a program, the path to it or information about the
|
||||
failure and possibly a hint how to fix it *)
|
||||
module Prog : sig
|
||||
module Not_found : sig
|
||||
type t =
|
||||
{ context : string
|
||||
; program : string
|
||||
; hint : string option
|
||||
}
|
||||
|
||||
val raise : t -> _
|
||||
end
|
||||
|
||||
type t = (Path.t, Not_found.t) result
|
||||
end
|
||||
|
||||
include Action_intf.Ast
|
||||
with type program := Path.t
|
||||
with type program := Prog.t
|
||||
with type path := Path.t
|
||||
with type string := string
|
||||
|
||||
|
|
|
@ -57,10 +57,10 @@ let create (context : Context.t) l ~f =
|
|||
; local_libs
|
||||
}
|
||||
|
||||
let binary t ?hint ?(in_the_tree=true) name =
|
||||
let binary t ?hint name =
|
||||
if not (Filename.is_relative name) then
|
||||
Ok (Path.absolute name)
|
||||
else if in_the_tree then begin
|
||||
else
|
||||
match String_map.find name t.local_bins with
|
||||
| Some path -> Ok path
|
||||
| None ->
|
||||
|
@ -68,24 +68,11 @@ let binary t ?hint ?(in_the_tree=true) name =
|
|||
| Some p -> Ok p
|
||||
| None ->
|
||||
Error
|
||||
{ fail = fun () ->
|
||||
Utils.program_not_found name
|
||||
~context:t.context.name
|
||||
?hint
|
||||
~in_the_tree:true
|
||||
{ Action.Prog.Not_found.
|
||||
program = name
|
||||
; hint
|
||||
; context = t.context.Context.name
|
||||
}
|
||||
end else begin
|
||||
match Context.which t.context name with
|
||||
| Some p -> Ok p
|
||||
| None ->
|
||||
Error
|
||||
{ fail = fun () ->
|
||||
Utils.program_not_found name
|
||||
~context:t.context.name
|
||||
?hint
|
||||
~in_the_tree:false
|
||||
}
|
||||
end
|
||||
|
||||
let file_of_lib t ~from ~lib ~file =
|
||||
match String_map.find lib t.local_libs with
|
||||
|
|
|
@ -8,17 +8,15 @@ val create
|
|||
-> f:('a -> Jbuild.Stanza.t list)
|
||||
-> t
|
||||
|
||||
(** A named artifact that is looked up in the PATH if not found in the tree or
|
||||
[in_the_tree] is [false].
|
||||
(** A named artifact that is looked up in the PATH if not found in the tree
|
||||
|
||||
If the name is an absolute path, it is used as it.
|
||||
*)
|
||||
val binary
|
||||
: t
|
||||
-> ?hint:string
|
||||
-> ?in_the_tree:bool (* default true *)
|
||||
-> string
|
||||
-> (Path.t, fail) result
|
||||
-> Action.Prog.t
|
||||
|
||||
(** [file_of_lib t ~from name] a named artifact that is looked up in the given library.
|
||||
|
||||
|
|
15
src/build.ml
15
src/build.ml
|
@ -6,12 +6,6 @@ module Vspec = struct
|
|||
type 'a t = T : Path.t * 'a Vfile_kind.t -> 'a t
|
||||
end
|
||||
|
||||
module Prog_spec = struct
|
||||
type 'a t =
|
||||
| Dep of Path.t
|
||||
| Dyn of ('a -> Path.t)
|
||||
end
|
||||
|
||||
type lib_dep_kind =
|
||||
| Optional
|
||||
| Required
|
||||
|
@ -194,10 +188,11 @@ let files_recursively_in ~dir ~file_tree =
|
|||
|
||||
let store_vfile spec = Store_vfile spec
|
||||
|
||||
let get_prog (prog : _ Prog_spec.t) =
|
||||
match prog with
|
||||
| Dep p -> path p >>> arr (fun _ -> p)
|
||||
| Dyn f -> arr f >>> dyn_paths (arr (fun x -> [x]))
|
||||
let get_prog = function
|
||||
| Ok p -> path p >>> arr (fun _ -> Ok p)
|
||||
| Error f ->
|
||||
arr (fun _ -> Error f)
|
||||
>>> dyn_paths (arr (function Error _ -> [] | Ok x -> [x]))
|
||||
|
||||
let prog_and_args ?(dir=Path.root) prog args =
|
||||
Paths (Arg_spec.add_deps args Pset.empty)
|
||||
|
|
|
@ -76,18 +76,12 @@ val fail : ?targets:Path.t list -> fail -> (_, _) t
|
|||
result is computed only once. *)
|
||||
val memoize : string -> (unit, 'a) t -> (unit, 'a) t
|
||||
|
||||
module Prog_spec : sig
|
||||
type 'a t =
|
||||
| Dep of Path.t
|
||||
| Dyn of ('a -> Path.t)
|
||||
end
|
||||
|
||||
val run
|
||||
: context:Context.t
|
||||
-> ?dir:Path.t (* default: [context.build_dir] *)
|
||||
-> ?stdout_to:Path.t
|
||||
-> ?extra_targets:Path.t list
|
||||
-> 'a Prog_spec.t
|
||||
-> Action.Prog.t
|
||||
-> 'a Arg_spec.t list
|
||||
-> ('a, Action.t) t
|
||||
|
||||
|
|
|
@ -108,7 +108,7 @@ module Gen(P : Params) = struct
|
|||
>>>
|
||||
Build.dyn_paths (Build.arr objs)
|
||||
>>>
|
||||
Build.run ~context:ctx (Dep compiler)
|
||||
Build.run ~context:ctx (Ok compiler)
|
||||
~extra_targets:(
|
||||
match mode with
|
||||
| Byte -> []
|
||||
|
@ -138,7 +138,7 @@ module Gen(P : Params) = struct
|
|||
(* We have to execute the rule in the library directory as the .o is produced in
|
||||
the current directory *)
|
||||
~dir
|
||||
(Dep ctx.ocamlc)
|
||||
(Ok ctx.ocamlc)
|
||||
[ As (Utils.g ())
|
||||
; Dyn (fun (c_flags, libs) ->
|
||||
S [ Lib.c_include_flags libs
|
||||
|
@ -163,9 +163,7 @@ module Gen(P : Params) = struct
|
|||
(* We have to execute the rule in the library directory as the .o is produced in
|
||||
the current directory *)
|
||||
~dir
|
||||
(SC.resolve_program sctx ctx.c_compiler
|
||||
(* The C compiler surely is not in the tree *)
|
||||
~in_the_tree:false)
|
||||
(SC.resolve_program sctx ctx.c_compiler)
|
||||
[ S [A "-I"; Path ctx.stdlib_dir]
|
||||
; As (SC.cxx_flags sctx)
|
||||
; Dyn (fun (cxx_flags, libs) ->
|
||||
|
@ -328,7 +326,7 @@ module Gen(P : Params) = struct
|
|||
>>>
|
||||
Build.run ~context:ctx
|
||||
~extra_targets:targets
|
||||
(Dep ctx.ocamlmklib)
|
||||
(Ok ctx.ocamlmklib)
|
||||
[ As (Utils.g ())
|
||||
; if custom then A "-custom" else As []
|
||||
; A "-o"
|
||||
|
@ -390,7 +388,7 @@ module Gen(P : Params) = struct
|
|||
Ocaml_flags.get flags Native
|
||||
>>>
|
||||
Build.run ~context:ctx
|
||||
(Dep ocamlopt)
|
||||
(Ok ocamlopt)
|
||||
[ Dyn (fun flags -> As flags)
|
||||
; A "-shared"; A "-linkall"
|
||||
; A "-I"; Path dir
|
||||
|
@ -473,7 +471,7 @@ module Gen(P : Params) = struct
|
|||
(SC.expand_and_eval_set sctx ~scope ~dir link_flags ~standard:[])
|
||||
>>>
|
||||
Build.run ~context:ctx
|
||||
(Dep compiler)
|
||||
(Ok compiler)
|
||||
[ Dyn (fun (_, (flags,_)) -> As flags)
|
||||
; A "-o"; Target exe
|
||||
; Dyn (fun (_, (_, link_flags)) -> As (link_custom @ link_flags))
|
||||
|
|
|
@ -63,7 +63,7 @@ let build_cm sctx ?sandbox ~dynlink ~flags ~cm_kind ~(dep_graph:Ocamldep.dep_gra
|
|||
other_cm_files >>>
|
||||
requires &&&
|
||||
Ocaml_flags.get_for_cm flags ~cm_kind >>>
|
||||
Build.run ~context:ctx (Dep compiler)
|
||||
Build.run ~context:ctx (Ok compiler)
|
||||
~extra_targets
|
||||
[ Dyn (fun (_, ocaml_flags) -> As ocaml_flags)
|
||||
; cmt_args
|
||||
|
|
|
@ -76,7 +76,7 @@ let rules sctx ~ml_kind ~dir ~item ~modules ~alias_module ~lib_interface_module
|
|||
in
|
||||
let ctx = SC.context sctx in
|
||||
SC.add_rule sctx
|
||||
(Build.run ~context:ctx (Dep ctx.ocamldep) [A "-modules"; S files]
|
||||
(Build.run ~context:ctx (Ok ctx.ocamldep) [A "-modules"; S files]
|
||||
~stdout_to:ocamldep_output);
|
||||
Build.memoize (Path.to_string ocamldep_output)
|
||||
(Build.lines_of ocamldep_output
|
||||
|
|
|
@ -82,13 +82,8 @@ let expand_vars t ~scope ~dir s =
|
|||
Some (Path.reach ~from:dir (Path.append t.context.build_dir scope.Scope.root))
|
||||
| var -> String_map.find var t.vars)
|
||||
|
||||
let resolve_program_internal t ?hint ?(in_the_tree=true) bin =
|
||||
Artifacts.binary t.artifacts ?hint ~in_the_tree bin
|
||||
|
||||
let resolve_program t ?hint ?in_the_tree bin =
|
||||
match resolve_program_internal t ?hint ?in_the_tree bin with
|
||||
| Error fail -> Build.Prog_spec.Dyn (fun _ -> fail.fail ())
|
||||
| Ok path -> Build.Prog_spec.Dep path
|
||||
let resolve_program t ?hint bin =
|
||||
Artifacts.binary ?hint t.artifacts bin
|
||||
|
||||
let create
|
||||
~(context:Context.t)
|
||||
|
@ -519,7 +514,6 @@ module Action = struct
|
|||
in
|
||||
let t =
|
||||
U.partial_expand dir t ~f:(fun loc key ->
|
||||
let module A = Artifacts in
|
||||
let open Action.Var_expansion in
|
||||
let cos, var = parse_bang key in
|
||||
match String.lsplit2 var ~on:':' with
|
||||
|
@ -527,21 +521,25 @@ module Action = struct
|
|||
| Some ("exe" , s) -> static_dep_exp acc (Path.relative dir s)
|
||||
| Some ("path" , s) -> static_dep_exp acc (Path.relative dir s)
|
||||
| Some ("bin" , s) -> begin
|
||||
match A.binary (artifacts sctx) s with
|
||||
| Ok path -> static_dep_exp acc path
|
||||
| Error fail -> add_fail acc fail
|
||||
match Artifacts.binary (artifacts sctx) s with
|
||||
| Ok path ->
|
||||
static_dep_exp acc path
|
||||
| Error e ->
|
||||
add_fail acc ({ fail = fun () -> Action.Prog.Not_found.raise e })
|
||||
end
|
||||
(* "findlib" for compatibility with Jane Street packages which are not yet updated
|
||||
to convert "findlib" to "lib" *)
|
||||
| Some (("lib"|"findlib"), s) -> begin
|
||||
let lib_dep, res = A.file_of_lib (artifacts sctx) ~loc ~from:dir s in
|
||||
let lib_dep, res =
|
||||
Artifacts.file_of_lib (artifacts sctx) ~loc ~from:dir s in
|
||||
add_lib_dep acc lib_dep dep_kind;
|
||||
match res with
|
||||
| Ok path -> static_dep_exp acc path
|
||||
| Error fail -> add_fail acc fail
|
||||
end
|
||||
| Some ("libexec" , s) -> begin
|
||||
let lib_dep, res = A.file_of_lib (artifacts sctx) ~loc ~from:dir s in
|
||||
let lib_dep, res =
|
||||
Artifacts.file_of_lib (artifacts sctx) ~loc ~from:dir s in
|
||||
add_lib_dep acc lib_dep dep_kind;
|
||||
match res with
|
||||
| Error fail -> add_fail acc fail
|
||||
|
@ -693,9 +691,9 @@ module Action = struct
|
|||
expand_step2 t ~dir ~dynamic_expansions ~deps_written_by_user
|
||||
in
|
||||
Action.Unresolved.resolve unresolved ~f:(fun prog ->
|
||||
match resolve_program_internal sctx prog with
|
||||
match Artifacts.binary sctx.artifacts prog with
|
||||
| Ok path -> path
|
||||
| Error fail -> fail.fail ()))
|
||||
| Error fail -> Action.Prog.Not_found.raise fail))
|
||||
>>>
|
||||
Build.dyn_paths (Build.arr (fun action ->
|
||||
let { Action.Infer.Outcome.deps; targets = _ } =
|
||||
|
@ -795,7 +793,7 @@ module PP = struct
|
|||
>>>
|
||||
Build.dyn_paths (Build.arr (Lib.archive_files ~mode ~ext_lib:ctx.ext_lib))
|
||||
>>>
|
||||
Build.run ~context:ctx (Dep compiler)
|
||||
Build.run ~context:ctx (Ok compiler)
|
||||
[ A "-o" ; Target target
|
||||
; Dyn (Lib.link_flags ~mode)
|
||||
])
|
||||
|
@ -833,7 +831,8 @@ module PP = struct
|
|||
a new module with only OCaml sources *)
|
||||
let setup_reason_rules sctx ~dir (m : Module.t) =
|
||||
let ctx = sctx.context in
|
||||
let refmt = resolve_program sctx "refmt" ~hint:"opam install reason" in
|
||||
let refmt =
|
||||
Artifacts.binary sctx.artifacts "refmt" ~hint:"opam install reason" in
|
||||
let rule src target =
|
||||
let src_path = Path.relative dir src in
|
||||
Build.run ~context:ctx refmt
|
||||
|
@ -895,7 +894,7 @@ module PP = struct
|
|||
(preprocessor_deps
|
||||
>>>
|
||||
Build.run ~context:sctx.context
|
||||
(Dep ppx_exe)
|
||||
(Ok ppx_exe)
|
||||
[ As flags
|
||||
; A "--dump-ast"
|
||||
; As (cookie_library_name lib_name)
|
||||
|
|
|
@ -58,19 +58,18 @@ val rules : t -> Build_interpret.Rule.t list
|
|||
|
||||
val sources_and_targets_known_so_far : t -> src_path:Path.t -> String_set.t
|
||||
|
||||
(** [prog_spec t ?hint ?in_the_tree name] resolve a program. If [in_the_tree] is [true]
|
||||
(the default), [name] is looked up in the workspace. Otherwise, or if it is not found
|
||||
in the tree is is looked up in the PATH. If it is not found at all, the resulting
|
||||
[Prog_spec.t] will fail when evaluated.
|
||||
(** [prog_spec t ?hint name] resolve a program. [name] is looked up in the
|
||||
workspace, if it is not found in the tree is is looked up in the PATH. If it
|
||||
is not found at all, the resulting [Prog_spec.t] will either return the
|
||||
resolved path or a record with details about the error and possibly a hint.
|
||||
|
||||
[hint] should tell the user what to install when the program is not found.
|
||||
*)
|
||||
val resolve_program
|
||||
: t
|
||||
-> ?hint:string
|
||||
-> ?in_the_tree:bool (* default true *)
|
||||
-> string
|
||||
-> _ Build.Prog_spec.t
|
||||
-> Action.Prog.t
|
||||
|
||||
module Libs : sig
|
||||
val find : t -> from:Path.t -> string -> Lib.t option
|
||||
|
|
|
@ -88,12 +88,9 @@ let describe_target fn =
|
|||
| _ ->
|
||||
Path.to_string_maybe_quoted fn
|
||||
|
||||
let program_not_found ?context ?(in_the_tree=false) ?hint prog =
|
||||
die "@{<error>Error@}: Program %s not found in%s PATH%s%a" (maybe_quoted prog)
|
||||
(if in_the_tree then
|
||||
" the tree or in"
|
||||
else
|
||||
"")
|
||||
let program_not_found ?context ?hint prog =
|
||||
die "@{<error>Error@}: Program %s not found in the tree or in PATH%s%a"
|
||||
(maybe_quoted prog)
|
||||
(match context with
|
||||
| None -> ""
|
||||
| Some name -> sprintf " (context: %s)" name)
|
||||
|
|
|
@ -18,11 +18,9 @@ val jbuild_name_in : dir:Path.t -> string
|
|||
(** Nice description of a target *)
|
||||
val describe_target : Path.t -> string
|
||||
|
||||
(** Raise an error about a program not found in the PATH. If [in_the_tree] is [true], then
|
||||
assume that the program was looked up in the tree as well. *)
|
||||
(** Raise an error about a program not found in the PATH or in the tree *)
|
||||
val program_not_found
|
||||
: ?context:string
|
||||
-> ?in_the_tree:bool (* default: false *)
|
||||
-> ?hint:string
|
||||
-> string
|
||||
-> _
|
||||
|
|
Loading…
Reference in New Issue