From 5c39a86c6e021929fc3c0569f1da474945d6e1e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Fri, 21 May 2021 22:21:58 +0200 Subject: [PATCH] [Sites] Better localisation of error MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes #4325 Signed-off-by: François Bobot --- otherlibs/site/test/run.t | 14 ++++++++++++++ src/dune_engine/install.ml | 15 ++++++++------- src/dune_engine/install.mli | 6 +++++- src/dune_rules/plugin_rules.ml | 2 +- src/dune_rules/super_context.ml | 22 +++++++++++----------- src/dune_rules/super_context.mli | 2 +- 6 files changed, 40 insertions(+), 21 deletions(-) diff --git a/otherlibs/site/test/run.t b/otherlibs/site/test/run.t index 34857a1eae0a..6c5a6f92a2e4 100644 --- a/otherlibs/site/test/run.t +++ b/otherlibs/site/test/run.t @@ -415,6 +415,20 @@ Test %{version:installed-pkg} Test error location --------------------------------- + $ cat >>a/dune < (install + > (section (site (non-existent foo))) + > (files a.ml) + > ) + > EOF + + $ dune build @install + File "a/dune", line 6, characters 16-34: + 6 | (section (site (non-existent foo))) + ^^^^^^^^^^^^^^^^^^ + Error: The package non-existent is not found + [1] + $ cat >a/dune < (library > (public_name a) diff --git a/src/dune_engine/install.ml b/src/dune_engine/install.ml index 2c4dd416989f..8299e70d7b86 100644 --- a/src/dune_engine/install.ml +++ b/src/dune_engine/install.ml @@ -86,6 +86,7 @@ module Section_with_site = struct | Site of { pkg : Package.Name.t ; site : Section.Site.t + ; loc : Loc.t } (* let compare : t -> t -> Ordering.t = Poly.compare *) @@ -94,12 +95,12 @@ module Section_with_site = struct let open Dyn.Encoder in match x with | Section s -> constr "Section" [ Section.to_dyn s ] - | Site { pkg; site } -> + | Site { pkg; site; loc = _ } -> constr "Section" [ Package.Name.to_dyn pkg; Section.Site.to_dyn site ] let to_string = function | Section s -> Section.to_string s - | Site { pkg; site } -> + | Site { pkg; site; loc = _ } -> sprintf "(site %s %s)" (Package.Name.to_string pkg) (Section.Site.to_string site) @@ -111,15 +112,15 @@ module Section_with_site = struct |> List.map ~f:(fun (k, d) -> (k, return (Section d)))) @ [ ( "site" , Dune_lang.Syntax.since Section.dune_site_syntax (0, 1) - >>> pair Package.Name.decode Section.Site.decode - >>| fun (pkg, site) -> Site { pkg; site } ) + >>> located (pair Package.Name.decode Section.Site.decode) + >>| fun (loc, (pkg, site)) -> Site { pkg; site; loc } ) ]) let encode = let open Dune_lang.Encoder in function | Section s -> Section.encode s - | Site { pkg; site } -> + | Site { pkg; site; loc = _ } -> constr "site" (pair Package.Name.encode Section.Site.encode) (pkg, site) end @@ -275,8 +276,8 @@ module Entry = struct let make_with_site section ?dst get_section src = match section with | Section_with_site.Section section -> make section ?dst src - | Site { pkg; site } -> - let section = get_section ~pkg ~site in + | Site { pkg; site; loc } -> + let section = get_section ~loc ~pkg ~site in let dst = adjust_dst' ~src ~dst ~section in let dst = Dst.add_prefix (Section.Site.to_string site) dst in let dst_with_pkg_prefix = diff --git a/src/dune_engine/install.mli b/src/dune_engine/install.mli index f7b755102278..473e78ba76aa 100644 --- a/src/dune_engine/install.mli +++ b/src/dune_engine/install.mli @@ -21,6 +21,7 @@ module Section_with_site : sig | Site of { pkg : Package.Name.t ; site : Section.Site.t + ; loc : Loc.t } val to_string : t -> string @@ -83,7 +84,10 @@ module Entry : sig val make_with_site : Section_with_site.t -> ?dst:string - -> (pkg:Package.Name.t -> site:Dune_section.Site.t -> Section.t) + -> ( loc:Loc.t + -> pkg:Package.Name.t + -> site:Dune_section.Site.t + -> Section.t) -> Path.Build.t -> Path.Build.t t diff --git a/src/dune_rules/plugin_rules.ml b/src/dune_rules/plugin_rules.ml index 16e0b9b90703..b92c3589196a 100644 --- a/src/dune_rules/plugin_rules.ml +++ b/src/dune_rules/plugin_rules.ml @@ -41,7 +41,7 @@ let install_rules ~sctx ~dir ({ name; site = loc, (pkg, site); _ } as t) = [ ( Some loc , Install.Entry.make_with_site ~dst:(sprintf "%s/%s" (Package.Name.to_string name) Findlib.meta_fn) - (Site { pkg; site }) + (Site { pkg; site; loc }) (Super_context.get_site_of_packages sctx) meta ) ] diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml index 630d2a631176..a8a7b582d240 100644 --- a/src/dune_rules/super_context.ml +++ b/src/dune_rules/super_context.ml @@ -256,12 +256,12 @@ let any_package_aux ~packages ~context pkg = let any_package t pkg = any_package_aux ~packages:t.packages ~context:t.context pkg -let get_site_of_packages_aux ~any_package ~pkg ~site = +let get_site_of_packages_aux ~loc ~any_package ~pkg ~site = let find_site sites ~pkg ~site = match Section.Site.Map.find sites site with | Some section -> section | None -> - User_error.raise + User_error.raise ~loc [ Pp.textf "Package %s doesn't define a site %s" (Package.Name.to_string pkg) (Section.Site.to_string site) @@ -271,11 +271,11 @@ let get_site_of_packages_aux ~any_package ~pkg ~site = | Some (Expander.Local p) -> find_site p.Package.sites ~pkg ~site | Some (Expander.Installed p) -> find_site p.sites ~pkg ~site | None -> - User_error.raise + User_error.raise ~loc [ Pp.textf "The package %s is not found" (Package.Name.to_string pkg) ] -let get_site_of_packages t ~pkg ~site = - get_site_of_packages_aux ~any_package:(any_package t) ~pkg ~site +let get_site_of_packages t ~loc ~pkg ~site = + get_site_of_packages_aux ~loc ~any_package:(any_package t) ~pkg ~site let lib_entries_of_package t pkg_name = Package.Name.Map.find t.lib_entries_by_package pkg_name @@ -583,15 +583,15 @@ let create ~(context : Context.t) ~host ~projects ~packages ~stanzas = let package_sections = Dir_with_dune.deep_fold stanzas ~init:Package.Name.Map.empty ~f:(fun _ stanza acc -> - let add_in_package_sites acc pkg site = - let section = get_site_of_packages_aux ~any_package ~pkg ~site in + let add_in_package_sites acc pkg site loc = + let section = get_site_of_packages_aux ~loc ~any_package ~pkg ~site in add_in_package_section acc pkg section in match stanza with - | Dune_file.Install { section = Site { pkg; site }; _ } -> - add_in_package_sites acc pkg site - | Dune_file.Plugin { site = _, (pkg, site); _ } -> - add_in_package_sites acc pkg site + | Dune_file.Install { section = Site { pkg; site; loc }; _ } -> + add_in_package_sites acc pkg site loc + | Dune_file.Plugin { site = loc, (pkg, site); _ } -> + add_in_package_sites acc pkg site loc | _ -> acc) in (* Add the site of the local package: it should only useful for making sure diff --git a/src/dune_rules/super_context.mli b/src/dune_rules/super_context.mli index b36d340b4e63..4c4768865a7e 100644 --- a/src/dune_rules/super_context.mli +++ b/src/dune_rules/super_context.mli @@ -37,7 +37,7 @@ val host : t -> t val any_package : t -> Package.Name.t -> Expander.any_package option val get_site_of_packages : - t -> pkg:Package.Name.t -> site:Section.Site.t -> Section.t + t -> loc:Loc.t -> pkg:Package.Name.t -> site:Section.Site.t -> Section.t module Lib_entry : sig type t =