matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Rudi Grinberg 2017-11-07 21:42:55 +08:00 committed by GitHub
parent 9c8ecc9fbc
commit a57c488dd7
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
13 changed files with 99 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/action.ml
View File

@ -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

18
src/action.mli
View File

@ -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

25
src/artifacts.ml
View File

@ -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

6
src/artifacts.mli
View File

@ -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
View File

@ -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)

8
src/build.mli
View File

@ -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

14
src/gen_rules.ml
View File

@ -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))

2
src/module_compilation.ml
View File

@ -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

2
src/ocamldep.ml
View File

@ -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

35
src/super_context.ml
View File

@ -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)

11
src/super_context.mli
View File

@ -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

9
src/utils.ml
View File

@ -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)

4
src/utils.mli
View File

@ -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
-> _