From 4483627348a9555b4e999ff941d795f34e5bc8aa Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 4 Aug 2018 13:13:16 +0300 Subject: [PATCH 1/5] Add tests for missing locations when running programs Signed-off-by: Rudi Grinberg --- test/blackbox-tests/dune.inc | 10 ++++++++++ .../test-cases/missing-loc-run/precise-path/dune | 3 +++ .../missing-loc-run/precise-path/dune-project | 1 + .../blackbox-tests/test-cases/missing-loc-run/run.t | 13 +++++++++++++ .../test-cases/missing-loc-run/search-path/dune | 3 +++ .../missing-loc-run/search-path/dune-project | 1 + 6 files changed, 31 insertions(+) create mode 100644 test/blackbox-tests/test-cases/missing-loc-run/precise-path/dune create mode 100644 test/blackbox-tests/test-cases/missing-loc-run/precise-path/dune-project create mode 100644 test/blackbox-tests/test-cases/missing-loc-run/run.t create mode 100644 test/blackbox-tests/test-cases/missing-loc-run/search-path/dune create mode 100644 test/blackbox-tests/test-cases/missing-loc-run/search-path/dune-project diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index fe593bba..c41db9a7 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -448,6 +448,14 @@ test-cases/misc (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name missing-loc-run) + (deps (package dune) (source_tree test-cases/missing-loc-run)) + (action + (chdir + test-cases/missing-loc-run + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name multi-dir) (deps (package dune) (source_tree test-cases/multi-dir)) @@ -789,6 +797,7 @@ (alias merlin-tests) (alias meta-gen) (alias misc) + (alias missing-loc-run) (alias multi-dir) (alias multiple-private-libs) (alias no-installable-mode) @@ -878,6 +887,7 @@ (alias merlin-tests) (alias meta-gen) (alias misc) + (alias missing-loc-run) (alias multi-dir) (alias no-installable-mode) (alias no-name-field) diff --git a/test/blackbox-tests/test-cases/missing-loc-run/precise-path/dune b/test/blackbox-tests/test-cases/missing-loc-run/precise-path/dune new file mode 100644 index 00000000..02b53eb9 --- /dev/null +++ b/test/blackbox-tests/test-cases/missing-loc-run/precise-path/dune @@ -0,0 +1,3 @@ +(alias + (name runtest) + (action (run ./foo.exe))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/missing-loc-run/precise-path/dune-project b/test/blackbox-tests/test-cases/missing-loc-run/precise-path/dune-project new file mode 100644 index 00000000..6687faf2 --- /dev/null +++ b/test/blackbox-tests/test-cases/missing-loc-run/precise-path/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/missing-loc-run/run.t b/test/blackbox-tests/test-cases/missing-loc-run/run.t new file mode 100644 index 00000000..a381f57a --- /dev/null +++ b/test/blackbox-tests/test-cases/missing-loc-run/run.t @@ -0,0 +1,13 @@ +Exact path provided by the user: + + $ dune runtest --root precise-path + Entering directory 'precise-path' + No rule found for foo.exe + [1] + +Path that needs to be searched: + + $ dune runtest --root search-path + Entering directory 'search-path' + Error: Program foo-does-not-exist not found in the tree or in PATH (context: default) + [1] diff --git a/test/blackbox-tests/test-cases/missing-loc-run/search-path/dune b/test/blackbox-tests/test-cases/missing-loc-run/search-path/dune new file mode 100644 index 00000000..27a97b63 --- /dev/null +++ b/test/blackbox-tests/test-cases/missing-loc-run/search-path/dune @@ -0,0 +1,3 @@ +(alias + (name runtest) + (action (run foo-does-not-exist))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/missing-loc-run/search-path/dune-project b/test/blackbox-tests/test-cases/missing-loc-run/search-path/dune-project new file mode 100644 index 00000000..6687faf2 --- /dev/null +++ b/test/blackbox-tests/test-cases/missing-loc-run/search-path/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) \ No newline at end of file From a064b5969261f95cc06122802fefc5151330e96b Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 4 Aug 2018 13:13:31 +0300 Subject: [PATCH 2/5] Track locations when executing programs Only works for searched programs for now Signed-off-by: Rudi Grinberg --- src/action.ml | 47 +++++++++++-------- src/action.mli | 5 +- src/artifacts.ml | 3 +- src/artifacts.mli | 1 + src/context.ml | 4 +- src/gen_rules.ml | 2 +- src/js_of_ocaml_rules.ml | 6 ++- src/menhir.ml | 2 +- src/odoc.ml | 2 +- src/preprocessing.ml | 2 +- src/super_context.ml | 10 ++-- src/super_context.mli | 1 + src/utils.ml | 5 +- src/utils.mli | 1 + src/watermarks.ml | 2 +- .../test-cases/missing-loc-run/run.t | 3 +- 16 files changed, 57 insertions(+), 39 deletions(-) diff --git a/src/action.ml b/src/action.ml index 8dfea8bc..0eaee018 100644 --- a/src/action.ml +++ b/src/action.ml @@ -1,6 +1,8 @@ open Import open Sexp.Of_sexp +let ignore_loc k ~loc:_ = k + module Outputs = struct include Action_intf.Outputs @@ -257,10 +259,11 @@ module Prog = struct { context : string ; program : string ; hint : string option + ; loc : Loc.t option } - let raise { context ; program ; hint } = - Utils.program_not_found ?hint ~context program + let raise { context ; program ; hint ; loc } = + Utils.program_not_found ?hint ~loc ~context program end type t = (Path.t, Not_found.t) result @@ -320,13 +323,13 @@ module Unresolved = struct module Program = struct type t = | This of Path.t - | Search of string + | Search of Loc.t option * string - let of_string ~dir s = + let of_string ~dir ~loc s = if String.contains s '/' then This (Path.relative dir s) else - Search s + Search (loc, s) end module type Uast = Action_intf.Ast @@ -345,18 +348,20 @@ module Unresolved = struct ~f_string:(fun ~dir:_ x -> x) ~f_program:(fun ~dir:_ -> function | This p -> Ok p - | Search s -> Ok (f s)) + | Search (loc, s) -> Ok (f loc s)) end -let prog_and_args_of_values p ~dir = +let prog_and_args_of_values ~loc p ~dir = match p with - | [] -> (Unresolved.Program.Search "", []) + | [] -> (Unresolved.Program.Search (loc, ""), []) | Value.Dir p :: _ -> die "%s is a directory and cannot be used as an executable" (Path.to_string_maybe_quoted p) | Value.Path p :: xs -> (This p, Value.L.to_strings ~dir xs) | String s :: xs -> - (Unresolved.Program.of_string ~dir s, Value.L.to_strings ~dir xs) + ( Unresolved.Program.of_string ~loc ~dir s + , Value.L.to_strings ~dir xs + ) module Unexpanded = struct module type Uast = Action_intf.Ast @@ -398,17 +403,19 @@ module Unexpanded = struct module E = struct let expand ~dir ~mode ~f ~l ~r = Either.map ~l - ~r:(fun s -> r (String_with_vars.expand s ~dir ~f ~mode) ~dir) + ~r:(fun s -> + r ~loc:(Some (String_with_vars.loc s)) + (String_with_vars.expand s ~dir ~f ~mode) ~dir) let string = expand ~mode:Single ~l:(fun x -> x) - ~r:Value.to_string + ~r:(ignore_loc Value.to_string) let strings = expand ~mode:Many ~l:(fun x -> [x]) - ~r:Value.L.to_strings + ~r:(ignore_loc Value.L.to_strings) let path e = let error_loc = @@ -417,7 +424,7 @@ module Unexpanded = struct | Right r -> Some (String_with_vars.loc r) in expand ~mode:Single ~l:(fun x -> x) - ~r:Value.(to_path ?error_loc) e + ~r:(ignore_loc (Value.(to_path ?error_loc))) e let prog_and_args = expand ~mode:Many @@ -488,15 +495,17 @@ module Unexpanded = struct module E = struct let expand ~dir ~mode ~f ~map x = match String_with_vars.partial_expand ~mode ~dir ~f x with - | Expanded e -> Left (map e ~dir) + | Expanded e -> + let loc = Some (String_with_vars.loc x) in + Left (map ~loc e ~dir) | Unexpanded x -> Right x - let string = expand ~mode:Single ~map:Value.to_string - let strings = expand ~mode:Many ~map:Value.L.to_strings - let cat_strings = expand ~mode:Many ~map:Value.L.concat + let string = expand ~mode:Single ~map:(ignore_loc Value.to_string) + let strings = expand ~mode:Many ~map:(ignore_loc Value.L.to_strings) + let cat_strings = expand ~mode:Many ~map:(ignore_loc Value.L.concat) let path x = - let error_loc = String_with_vars.loc x in - expand ~mode:Single ~map:(Value.to_path ~error_loc) x + expand ~mode:Single ~map:(fun ~loc v ~dir -> + Value.to_path ?error_loc:loc v ~dir) x let prog_and_args = expand ~mode:Many ~map:prog_and_args_of_values end diff --git a/src/action.mli b/src/action.mli index ae33e4f9..7fc81485 100644 --- a/src/action.mli +++ b/src/action.mli @@ -11,6 +11,7 @@ module Prog : sig { context : string ; program : string ; hint : string option + ; loc : Loc.t option } val raise : t -> _ @@ -54,7 +55,7 @@ module Unresolved : sig module Program : sig type t = | This of Path.t - | Search of string + | Search of Loc.t option * string end include Action_intf.Ast @@ -62,7 +63,7 @@ module Unresolved : sig with type path := Path.t with type string := string - val resolve : t -> f:(string -> Path.t) -> action + val resolve : t -> f:(Loc.t option -> string -> Path.t) -> action end with type action := t module Unexpanded : sig diff --git a/src/artifacts.ml b/src/artifacts.ml index f9520e73..344288d4 100644 --- a/src/artifacts.ml +++ b/src/artifacts.ml @@ -51,7 +51,7 @@ let create (context : Context.t) ~public_libs l ~f = ; public_libs } -let binary t ?hint name = +let binary t ?hint ~loc name = if not (Filename.is_relative name) then Ok (Path.of_filename_relative_to_initial_cwd name) else @@ -66,6 +66,7 @@ let binary t ?hint name = program = name ; hint ; context = t.context.Context.name + ; loc } let file_of_lib t ~loc ~lib ~file = diff --git a/src/artifacts.mli b/src/artifacts.mli index 3786bb85..b80f0f71 100644 --- a/src/artifacts.mli +++ b/src/artifacts.mli @@ -16,6 +16,7 @@ val create val binary : t -> ?hint:string + -> loc:Loc.t option -> string -> Action.Prog.t diff --git a/src/context.ml b/src/context.ml index 31242d42..e25cb971 100644 --- a/src/context.ml +++ b/src/context.ml @@ -146,7 +146,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets Hashtbl.add opam_var_cache "root" root | Default -> ()); let prog_not_found_in_path prog = - Utils.program_not_found prog ~context:name + Utils.program_not_found prog ~context:name ~loc:None in let which_cache = Hashtbl.create 128 in let which x = which ~cache:which_cache ~path x in @@ -424,7 +424,7 @@ let default ?(merlin=true) ~env_nodes ~env ~targets () = let create_for_opam ?root ~env ~env_nodes ~targets ~profile ~switch ~name ?(merlin=false) () = match Bin.opam with - | None -> Utils.program_not_found "opam" + | None -> Utils.program_not_found "opam" ~loc:None | Some fn -> (match root with | Some root -> Fiber.return root diff --git a/src/gen_rules.ml b/src/gen_rules.ml index b5478a47..aa08064c 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -133,7 +133,7 @@ module Gen(P : Install_rules.Params) = struct (* We have to execute the rule in the library directory as the .o is produced in the current directory *) ~dir:(Path.parent_exn src) - (SC.resolve_program sctx ctx.c_compiler) + (SC.resolve_program ~loc:None sctx ctx.c_compiler) ([ S [A "-I"; Path ctx.stdlib_dir] ; As (SC.cxx_flags sctx) ; includes diff --git a/src/js_of_ocaml_rules.ml b/src/js_of_ocaml_rules.ml index 1c4ed99b..910871fb 100644 --- a/src/js_of_ocaml_rules.ml +++ b/src/js_of_ocaml_rules.ml @@ -33,7 +33,8 @@ let runtime_file ~sctx fname = | Ok f -> Arg_spec.Dep f let js_of_ocaml_rule sctx ~dir ~flags ~spec ~target = - let jsoo = SC.resolve_program sctx ~hint:install_jsoo_hint "js_of_ocaml" in + let jsoo = + SC.resolve_program sctx ~loc:None ~hint:install_jsoo_hint "js_of_ocaml" in let runtime = runtime_file ~sctx "runtime.js" in Build.run ~context:(Super_context.context sctx) ~dir jsoo @@ -98,7 +99,8 @@ let link_rule cc ~runtime ~target = in Arg_spec.Deps (List.concat [all_libs;all_other_modules])) in - let jsoo_link = SC.resolve_program sctx ~hint:install_jsoo_hint "jsoo_link" in + let jsoo_link = + SC.resolve_program sctx ~loc:None ~hint:install_jsoo_hint "jsoo_link" in Build.run ~context:ctx ~dir:(Compilation_context.dir cc) jsoo_link [ Arg_spec.A "-o"; Target target diff --git a/src/menhir.ml b/src/menhir.ml index 05c466dd..61f13f3a 100644 --- a/src/menhir.ml +++ b/src/menhir.ml @@ -71,7 +71,7 @@ module Run (P : PARAMS) = struct (* Find the menhir binary. *) let menhir_binary = - SC.resolve_program sctx "menhir" ~hint:"opam install menhir" + SC.resolve_program sctx "menhir" ~loc:None ~hint:"opam install menhir" (* [menhir args] generates a Menhir command line (a build action). *) diff --git a/src/odoc.ml b/src/odoc.ml index a9989b2b..542ac69b 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -83,7 +83,7 @@ module Gen (S : sig val sctx : SC.t end) = struct let setup_deps m files = SC.add_alias_deps sctx (alias m) files end - let odoc = SC.resolve_program sctx "odoc" ~hint:"opam install odoc" + let odoc = SC.resolve_program sctx "odoc" ~hint:"opam install odoc" ~loc:None let odoc_ext = ".odoc" module Mld : sig diff --git a/src/preprocessing.ml b/src/preprocessing.ml index f9eafaf7..7c63ad0b 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -415,7 +415,7 @@ let cookie_library_name lib_name = let setup_reason_rules sctx (m : Module.t) = let ctx = SC.context sctx in let refmt = - Artifacts.binary (SC.artifacts sctx) "refmt" ~hint:"opam install reason" in + SC.resolve_program sctx ~loc:None "refmt" ~hint:"opam install reason" in let rule src target = Build.run ~context:ctx refmt [ A "--print" diff --git a/src/super_context.ml b/src/super_context.ml index de47e8cf..ee8a53fe 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -289,7 +289,7 @@ end = struct | Macro (Dep, s) -> Some (path_exp (Path.relative dir s)) | Macro (Bin, s) -> begin let sctx = host sctx in - match Artifacts.binary (artifacts sctx) s with + match Artifacts.binary ~loc:None (artifacts sctx) s with | Ok path -> Some (path_exp path) | Error e -> Resolved_forms.add_fail acc @@ -482,8 +482,8 @@ let ocaml_flags t ~dir ~scope (x : Buildable.t) = let dump_env t ~dir = Ocaml_flags.dump (Env.ocaml_flags t ~dir) -let resolve_program t ?hint bin = - Artifacts.binary ?hint t.artifacts bin +let resolve_program t ?hint ~loc bin = + Artifacts.binary ?hint ~loc t.artifacts bin let create ~(context:Context.t) @@ -920,9 +920,9 @@ module Action = struct expand_step2 t ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe ~bindings in - Action.Unresolved.resolve unresolved ~f:(fun prog -> + Action.Unresolved.resolve unresolved ~f:(fun loc prog -> let sctx = host sctx in - match Artifacts.binary sctx.artifacts prog with + match Artifacts.binary ~loc sctx.artifacts prog with | Ok path -> path | Error fail -> Action.Prog.Not_found.raise fail)) >>> diff --git a/src/super_context.mli b/src/super_context.mli index 2cd05396..54e1eff3 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -170,6 +170,7 @@ val source_files : t -> src_path:Path.t -> String.Set.t val resolve_program : t -> ?hint:string + -> loc:Loc.t option -> string -> Action.Prog.t diff --git a/src/utils.ml b/src/utils.ml index 2c9f22d6..531a5d70 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -113,8 +113,9 @@ let library_object_directory ~dir name = let executable_object_directory ~dir name = Path.relative dir ("." ^ name ^ ".eobjs") -let program_not_found ?context ?hint prog = - die "@{Error@}: Program %s not found in the tree or in PATH%s%a" +let program_not_found ?context ?hint ~loc prog = + Loc.fail_opt loc + "@{Error@}: Program %s not found in the tree or in PATH%s%a" (String.maybe_quoted prog) (match context with | None -> "" diff --git a/src/utils.mli b/src/utils.mli index a5bf7cee..e1789cda 100644 --- a/src/utils.mli +++ b/src/utils.mli @@ -41,6 +41,7 @@ val analyse_target : Path.t -> target_kind val program_not_found : ?context:string -> ?hint:string + -> loc:Loc.t option -> string -> _ diff --git a/src/watermarks.ml b/src/watermarks.ml index 2b64a595..aff2ef61 100644 --- a/src/watermarks.ml +++ b/src/watermarks.ml @@ -230,7 +230,7 @@ let subst_git ?name () = let git = match Bin.which "git" with | Some x -> x - | None -> Utils.program_not_found "git" + | None -> Utils.program_not_found "git" ~loc:None in let env = Env.initial in Fiber.fork_and_join diff --git a/test/blackbox-tests/test-cases/missing-loc-run/run.t b/test/blackbox-tests/test-cases/missing-loc-run/run.t index a381f57a..ad5d6f3b 100644 --- a/test/blackbox-tests/test-cases/missing-loc-run/run.t +++ b/test/blackbox-tests/test-cases/missing-loc-run/run.t @@ -9,5 +9,6 @@ Path that needs to be searched: $ dune runtest --root search-path Entering directory 'search-path' - Error: Program foo-does-not-exist not found in the tree or in PATH (context: default) + File "dune", line 3, characters 14-32: + Error: Error: Program foo-does-not-exist not found in the tree or in PATH (context: default) [1] From b3d87dc16379e50d0883b2a70b6bf46868139050 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 4 Aug 2018 13:22:19 +0300 Subject: [PATCH 3/5] Update CHANGES Signed-off-by: Rudi Grinberg --- CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index d4c36ee5..e31389d2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -30,6 +30,9 @@ next - Fix placeholders in `dune subst` documentation (#1090, @emillon, thanks @trefis for the bug report) +- Add locations to errors when a missing binary in PATH comes from a dune file + (#1096, fixes #1095, @rgrinberg) + 1.0.1 (19/07/2018) ------------------ From b9cbdd236bdff25993dd51d79ce4f9468b152d19 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 4 Aug 2018 19:59:16 +0300 Subject: [PATCH 4/5] Add test case for deps field Signed-off-by: Rudi Grinberg --- .../test-cases/missing-loc-run/alias-deps-field/dune | 3 +++ .../missing-loc-run/alias-deps-field/dune-project | 1 + test/blackbox-tests/test-cases/missing-loc-run/run.t | 8 ++++++++ 3 files changed, 12 insertions(+) create mode 100644 test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field/dune create mode 100644 test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field/dune-project diff --git a/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field/dune b/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field/dune new file mode 100644 index 00000000..472aea9d --- /dev/null +++ b/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field/dune @@ -0,0 +1,3 @@ +(alias + (name runtest) + (deps foobar)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field/dune-project b/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field/dune-project new file mode 100644 index 00000000..6687faf2 --- /dev/null +++ b/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/missing-loc-run/run.t b/test/blackbox-tests/test-cases/missing-loc-run/run.t index ad5d6f3b..c09b42eb 100644 --- a/test/blackbox-tests/test-cases/missing-loc-run/run.t +++ b/test/blackbox-tests/test-cases/missing-loc-run/run.t @@ -12,3 +12,11 @@ Path that needs to be searched: File "dune", line 3, characters 14-32: Error: Error: Program foo-does-not-exist not found in the tree or in PATH (context: default) [1] + +Path in deps field of alias stanza + + $ dune runtest --root alias-deps-field + Entering directory 'alias-deps-field' + File "dune", line 1, characters 0-38: + Error: No rule found for foobar + [1] From 66f2004f8f47dc1e1b879e7495fde93a782a17e5 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 4 Aug 2018 20:03:58 +0300 Subject: [PATCH 5/5] Add rule locs to failed rules this will add a location that will point to the rule that failed Signed-off-by: Rudi Grinberg --- src/build_system.ml | 38 ++++++++++--------- src/build_system.mli | 1 + src/gen_rules.ml | 1 + src/inline_tests.ml | 1 + src/jbuild.ml | 3 ++ src/jbuild.mli | 1 + src/preprocessing.ml | 3 +- src/simple_rules.ml | 7 +++- src/super_context.ml | 5 ++- src/super_context.mli | 1 + .../test-cases/missing-loc-run/run.t | 3 +- 11 files changed, 40 insertions(+), 24 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index bd76f712..6f3e924e 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -354,6 +354,7 @@ module Dir_status = struct ; action : (unit, Action.t) Build.t ; locks : Path.t list ; context : Context.t + ; loc : Loc.t option } @@ -684,15 +685,15 @@ let remove_old_artifacts t ~dir ~subdirs_to_keep = if not (Path.Table.mem t.files path) then Path.unlink path) let no_rule_found = - let fail fn = - die "No rule found for %s" (Utils.describe_target fn) + let fail fn ~loc = + Loc.fail_opt loc "No rule found for %s" (Utils.describe_target fn) in - fun t fn -> + fun t ~loc fn -> match Utils.analyse_target fn with - | Other _ -> fail fn + | Other _ -> fail fn ~loc | Regular (ctx, _) -> if String.Map.mem t.contexts ctx then - fail fn + fail fn ~loc else die "Trying to build %s but build context %s doesn't exist.%s" (Path.to_string_maybe_quoted fn) @@ -700,7 +701,7 @@ let no_rule_found = (hint ctx (String.Map.keys t.contexts)) | Alias (ctx, fn') -> if String.Map.mem t.contexts ctx then - fail fn + fail fn ~loc else let fn = Path.append (Path.relative Path.build_dir ctx) fn' in die "Trying to build alias %s but build context %s doesn't exist.%s" @@ -729,7 +730,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule = let eval_rule () = t.hook Rule_started; - wait_for_deps t (Lazy.force static_deps).rule_deps + wait_for_deps t (Lazy.force static_deps).rule_deps ~loc >>| fun () -> Build_exec.exec t build () in @@ -737,10 +738,10 @@ let rec compile_rule t ?(copy_source=false) pre_rule = let static_deps = (Lazy.force static_deps).action_deps in Fiber.fork_and_join_unit (fun () -> - wait_for_deps t static_deps) + wait_for_deps ~loc t static_deps) (fun () -> Fiber.Future.wait rule_evaluation >>= fun (action, dyn_deps) -> - wait_for_deps t (Path.Set.diff dyn_deps static_deps) + wait_for_deps ~loc t (Path.Set.diff dyn_deps static_deps) >>| fun () -> (action, dyn_deps)) >>= fun (action, dyn_deps) -> @@ -949,13 +950,13 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators = let rules, deps = List.fold_left actions ~init:(rules, deps) ~f:(fun (rules, deps) - { Dir_status. stamp; action; locks ; context } -> + { Dir_status. stamp; action; locks ; context ; loc } -> let path = Path.extend_basename base_path ~suffix:("-" ^ Digest.to_hex stamp) in let rule = - Pre_rule.make ~locks ~context:(Some context) + Pre_rule.make ~locks ~context:(Some context) ?loc (Build.progn [ action; Build.create_file path ]) in (rule :: rules, Path.Set.add deps path)) @@ -1107,7 +1108,7 @@ The following targets are not: targets -and wait_for_file t fn = +and wait_for_file t ~loc fn = match Path.Table.find t.files fn with | Some file -> wait_for_file_found fn file | None -> @@ -1116,7 +1117,7 @@ and wait_for_file t fn = load_dir t ~dir; match Path.Table.find t.files fn with | Some file -> wait_for_file_found fn file - | None -> no_rule_found t fn + | None -> no_rule_found t ~loc fn end else if Path.exists fn then Fiber.return () else @@ -1146,8 +1147,8 @@ and wait_for_file_found fn (File_spec.T file) = }; Fiber.Future.wait rule_execution) -and wait_for_deps t deps = - Fiber.parallel_iter (Path.Set.to_list deps) ~f:(wait_for_file t) +and wait_for_deps ~loc t deps = + Fiber.parallel_iter (Path.Set.to_list deps) ~f:(wait_for_file ~loc t) let stamp_file_for_files_of t ~dir ~ext = let files_of_dir = @@ -1260,7 +1261,7 @@ let eval_request t ~request ~process_target = Fiber.fork_and_join_unit (fun () -> process_targets static_deps) (fun () -> - wait_for_deps t rule_deps + wait_for_deps t ~loc:None rule_deps >>= fun () -> let result, dyn_deps = Build_exec.exec t request () in process_targets (Path.Set.diff dyn_deps static_deps) @@ -1285,7 +1286,7 @@ let update_universe t = let do_build t ~request = entry_point t ~f:(fun () -> update_universe t; - eval_request t ~request ~process_target:(wait_for_file t)) + eval_request t ~request ~process_target:(wait_for_file ~loc:None t)) module Ir_set = Set.Make(Internal_rule) @@ -1616,12 +1617,13 @@ module Alias = struct Build.fanout def.dyn_deps build >>^ fun (a, b) -> Path.Set.union a b - let add_action build_system t ~context ?(locks=[]) ~stamp action = + let add_action build_system t ~context ~loc ?(locks=[]) ~stamp action = let def = get_alias_def build_system t in def.actions <- { stamp = Digest.string (Sexp.to_string ~syntax:Dune stamp) ; action ; locks ; context + ; loc } :: def.actions end diff --git a/src/build_system.mli b/src/build_system.mli index 381353b5..a26e2e77 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -171,6 +171,7 @@ module Alias : sig : build_system -> t -> context:Context.t + -> loc:Loc.t option -> ?locks:Path.t list -> stamp:Sexp.t -> (unit, Action.t) Build.t diff --git a/src/gen_rules.ml b/src/gen_rules.ml index aa08064c..8d7deee0 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -608,6 +608,7 @@ module Gen(P : Install_rules.Params) = struct ; deps = t.deps ; action = None ; enabled_if = t.enabled_if + ; loc } in match test_kind (loc, s) with | `Regular -> diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 115da9ac..783ba6ed 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -258,6 +258,7 @@ include Sub_system.Register_end_point( in SC.add_alias_action sctx + ~loc:(Some info.loc) (Build_system.Alias.runtest ~dir) ~stamp:(List [ Sexp.unsafe_atom_of_string "ppx-runner" ; Quoted_string name diff --git a/src/jbuild.ml b/src/jbuild.ml index 91e59e32..7d35c670 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1558,6 +1558,7 @@ module Alias_conf = struct ; locks : String_with_vars.t list ; package : Package.t option ; enabled_if : String_with_vars.t Blang.t option + ; loc : Loc.t } let alias_name = @@ -1570,6 +1571,7 @@ module Alias_conf = struct let t = record (let%map name = field "name" alias_name + and loc = loc and package = field_o "package" Pkg.t and action = field_o "action" (located Action.Unexpanded.t) and locks = field "locks" (list String_with_vars.t) ~default:[] @@ -1582,6 +1584,7 @@ module Alias_conf = struct ; package ; locks ; enabled_if + ; loc }) end diff --git a/src/jbuild.mli b/src/jbuild.mli index 37f284fe..83720cd3 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -338,6 +338,7 @@ module Alias_conf : sig ; locks : String_with_vars.t list ; package : Package.t option ; enabled_if : String_with_vars.t Blang.t option + ; loc : Loc.t } end diff --git a/src/preprocessing.ml b/src/preprocessing.ml index 7c63ad0b..0087d5f4 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -475,7 +475,7 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind = let action = Action.Unexpanded.Chdir (workspace_root_var, action) in Module.iter source ~f:(fun _ (src : Module.File.t) -> let bindings = Pform.Map.input_file src.path in - add_alias src.path + add_alias src.path ~loc:None (Build.path src.path >>^ (fun _ -> Jbuild.Bindings.empty) >>> SC.Action.run sctx @@ -516,6 +516,7 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind = (fun ~source ~ast -> Module.iter ast ~f:(fun kind src -> add_alias src.path + ~loc:None (promote_correction ~suffix:corrected_suffix (Option.value_exn (Module.file source kind)) (Build.of_result_map driver_and_flags ~f:(fun (exe, flags) -> diff --git a/src/simple_rules.ml b/src/simple_rules.ml index 2cc62a51..de41af2c 100644 --- a/src/simple_rules.ml +++ b/src/simple_rules.ml @@ -65,9 +65,9 @@ let copy_files sctx ~dir ~scope ~src_dir (def: Copy_files.t) = ~dst:file_dst); file_dst) -let add_alias sctx ~dir ~name ~stamp ?(locks=[]) build = +let add_alias sctx ~dir ~name ~stamp ~loc ?(locks=[]) build = let alias = Build_system.Alias.make name ~dir in - SC.add_alias_action sctx alias ~locks ~stamp build + SC.add_alias_action sctx alias ~loc ~locks ~stamp build let alias sctx ~dir ~scope (alias_conf : Alias_conf.t) = let enabled = @@ -91,9 +91,11 @@ let alias sctx ~dir ~scope (alias_conf : Alias_conf.t) = (Option.map alias_conf.action ~f:snd) ] in + let loc = Some alias_conf.loc in if enabled then add_alias sctx ~dir + ~loc ~name:alias_conf.name ~stamp ~locks:(interpret_locks sctx ~dir ~scope alias_conf.locks) @@ -114,6 +116,7 @@ let alias sctx ~dir ~scope (alias_conf : Alias_conf.t) = ~scope) else add_alias sctx + ~loc ~dir ~name:alias_conf.name ~stamp diff --git a/src/super_context.ml b/src/super_context.ml index ee8a53fe..060db608 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -112,8 +112,9 @@ let add_rules t ?sandbox builds = let add_alias_deps t alias ?dyn_deps deps = Alias.add_deps t.build_system alias ?dyn_deps deps -let add_alias_action t alias ?locks ~stamp action = - Alias.add_action t.build_system ~context:t.context alias ?locks ~stamp action +let add_alias_action t alias ~loc ?locks ~stamp action = + Alias.add_action t.build_system ~context:t.context alias ~loc ?locks + ~stamp action let eval_glob t ~dir re = Build_system.eval_glob t.build_system ~dir re let load_dir t ~dir = Build_system.load_dir t.build_system ~dir diff --git a/src/super_context.mli b/src/super_context.mli index 54e1eff3..126d727d 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -148,6 +148,7 @@ val add_alias_deps val add_alias_action : t -> Build_system.Alias.t + -> loc:Loc.t option -> ?locks:Path.t list -> stamp:Sexp.t -> (unit, Action.t) Build.t diff --git a/test/blackbox-tests/test-cases/missing-loc-run/run.t b/test/blackbox-tests/test-cases/missing-loc-run/run.t index c09b42eb..0b5d8d24 100644 --- a/test/blackbox-tests/test-cases/missing-loc-run/run.t +++ b/test/blackbox-tests/test-cases/missing-loc-run/run.t @@ -2,7 +2,8 @@ Exact path provided by the user: $ dune runtest --root precise-path Entering directory 'precise-path' - No rule found for foo.exe + File "dune", line 1, characters 0-49: + Error: No rule found for foo.exe [1] Path that needs to be searched: