From af39ab8c20f917b802483aa8154a4120dcfe6eda Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 28 Feb 2024 07:42:33 +0000 Subject: [PATCH] fix: allow looking up artifacts everywhere Signed-off-by: Rudi Grinberg --- bin/target.ml | 19 +++-- doc/changes/10169.md | 2 + src/dune_rules/dir_contents.ml | 19 ++--- src/dune_rules/dir_contents.mli | 6 -- src/dune_rules/expander.ml | 78 +++++++++---------- src/dune_rules/expander.mli | 3 +- src/dune_rules/gen_rules.ml | 13 +--- .../variables-for-artifacts.t/run.t | 6 +- 8 files changed, 70 insertions(+), 76 deletions(-) create mode 100644 doc/changes/10169.md diff --git a/bin/target.ml b/bin/target.ml index 84f672d6ea8..00baa64614d 100644 --- a/bin/target.ml +++ b/bin/target.ml @@ -168,15 +168,18 @@ let resolve_path path ~(setup : Dune_rules.Main.build_system) ;; let expand_path_from_root (root : Workspace_root.t) sctx sv = - let ctx = Super_context.context sctx in - let dir = - Path.Build.relative - (Context.build_dir ctx) - (String.concat ~sep:Filename.dir_sep root.to_cwd) + let+ s = + let* expander = + let dir = + let ctx = Super_context.context sctx in + Path.Build.relative + (Context.build_dir ctx) + (String.concat ~sep:Filename.dir_sep root.to_cwd) + in + Action_builder.of_memo (Dune_rules.Super_context.expander sctx ~dir) + in + Dune_rules.Expander.expand_str expander sv in - let* expander = Action_builder.of_memo (Dune_rules.Super_context.expander sctx ~dir) in - let expander = Dune_rules.Dir_contents.add_sources_to_expander sctx expander in - let+ s = Dune_rules.Expander.expand_str expander sv in root.reach_from_root_prefix ^ s ;; diff --git a/doc/changes/10169.md b/doc/changes/10169.md new file mode 100644 index 00000000000..42307c81768 --- /dev/null +++ b/doc/changes/10169.md @@ -0,0 +1,2 @@ +- Allow artifact expansion percent forms (`%{cma:..}`, `%{cmo:..}`, etc.) in + more contexts. Previously, they would be randomly forbidden in some fields. diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index fc2522e1c97..082cfb71cc5 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -154,13 +154,7 @@ let build_mlds_map stanzas ~dir ~files = module rec Load : sig val get : Super_context.t -> dir:Path.Build.t -> t Memo.t val triage : Super_context.t -> dir:Path.Build.t -> triage Memo.t - val add_sources_to_expander : Super_context.t -> Expander.t -> Expander.t end = struct - let add_sources_to_expander sctx expander = - let f ~dir = Load.get sctx ~dir >>= artifacts in - Expander.set_lookup_ml_sources expander ~f - ;; - let select_deps_files libraries = (* Manually add files generated by the (select ...) dependencies *) @@ -179,9 +173,7 @@ end = struct (* Interpret a few stanzas in order to determine the list of files generated by the user. *) let+ generated_files = - let* expander = - Super_context.expander sctx ~dir >>| add_sources_to_expander sctx - in + let* expander = Super_context.expander sctx ~dir in Memo.parallel_map stanzas ~f:(fun stanza -> match Stanza.repr stanza with | Coq_stanza.Coqpp.T { modules; _ } -> @@ -474,3 +466,12 @@ let modules_of_lib sctx lib = let+ modules = modules_of_local_lib sctx (Lib.Local.of_lib_exn lib) in Some modules ;; + +let () = + Fdecl.set Expander.lookup_artifacts (fun ~dir -> + Context.DB.by_dir dir + >>| Context.name + >>= Super_context.find_exn + >>= Load.get ~dir + >>= artifacts) +;; diff --git a/src/dune_rules/dir_contents.mli b/src/dune_rules/dir_contents.mli index 766eaad2937..09670eff494 100644 --- a/src/dune_rules/dir_contents.mli +++ b/src/dune_rules/dir_contents.mli @@ -65,9 +65,3 @@ type triage = However, if the directory is part of a group, this function simply returns the root of the group. *) val triage : Super_context.t -> dir:Path.Build.t -> triage Memo.t - -(** Add expansion that depend on OCaml artifacts/sources. - - This function live in super_context.ml or expander.ml because it would - introduce a dependency cycle. *) -val add_sources_to_expander : Super_context.t -> Expander.t -> Expander.t diff --git a/src/dune_rules/expander.ml b/src/dune_rules/expander.ml index 2ac0ab3b66d..0b9f5c223a0 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -44,6 +44,8 @@ end type value = Value.t list Deps.t +let lookup_artifacts = Fdecl.create Dyn.opaque + type t = { dir : Path.Build.t ; env : Env.t @@ -55,7 +57,6 @@ type t = ; scope : Scope.t ; scope_host : Scope.t ; context : Context.t - ; lookup_artifacts : (dir:Path.Build.t -> Artifacts_obj.t Memo.t) option ; expanding_what : Expanding_what.t } @@ -70,7 +71,6 @@ let set_local_env_var t ~var ~value = let set_dir t ~dir = { t with dir } let set_scope t ~scope ~scope_host = { t with scope; scope_host } let set_artifacts t ~artifacts_host = { t with artifacts_host } -let set_lookup_ml_sources t ~f = { t with lookup_artifacts = Some f } let set_expanding_what t x = { t with expanding_what = x } let map_exe t p = @@ -155,46 +155,41 @@ let expand_version { scope; _ } ~(source : Dune_lang.Template.Pform.t) s = ]) ;; -let expand_artifact ~source t a s = - match t.lookup_artifacts with - | None -> isn't_allowed_in_this_position ~source - | Some lookup -> - let path = Path.Build.relative t.dir s in - let name = Path.Build.basename path in - let dir = Path.Build.parent_exn path in - let does_not_exist ~loc ~what name = - User_error.raise ~loc [ Pp.textf "%s %s does not exist." what name ] +let expand_artifact ~source t artifact arg = + let path = Path.Build.relative t.dir arg in + let loc = Dune_lang.Template.Pform.loc source in + let name = Path.Build.basename path in + let dir = Path.Build.parent_exn path in + if Path.Build.is_root dir + then User_error.raise ~loc [ Pp.text "cannot escape the workspace root directory" ]; + let does_not_exist ~what name = + User_error.raise ~loc [ Pp.textf "%s %s does not exist." what name ] + in + let* artifacts = + let lookup = Fdecl.get lookup_artifacts in + Action_builder.of_memo (lookup ~dir) + in + match artifact with + | Pform.Artifact.Mod kind -> + let name = + Module_name.of_string_allow_invalid (Dune_lang.Template.Pform.loc source, name) in - let* artifacts = Action_builder.of_memo (lookup ~dir) in - (match a with - | Pform.Artifact.Mod kind -> - let name = - Module_name.of_string_allow_invalid (Dune_lang.Template.Pform.loc source, name) - in - (match Artifacts_obj.lookup_module artifacts name with - | None -> - does_not_exist - ~loc:(Dune_lang.Template.Pform.loc source) - ~what:"Module" - (Module_name.to_string name) - | Some (t, m) -> - (match Obj_dir.Module.cm_file t m ~kind:(Ocaml kind) with - | None -> Action_builder.return [ Value.String "" ] - | Some path -> dep (Path.build path))) - | Lib mode -> - let name = Lib_name.parse_string_exn (Dune_lang.Template.Pform.loc source, name) in - (match Artifacts_obj.lookup_library artifacts name with - | None -> - does_not_exist - ~loc:(Dune_lang.Template.Pform.loc source) - ~what:"Library" - (Lib_name.to_string name) - | Some lib -> - Mode.Dict.get (Lib_info.archives lib) mode - |> Action_builder.List.map ~f:(fun fn -> - let fn = Path.build fn in - let+ () = Action_builder.path fn in - Value.Path fn))) + (match Artifacts_obj.lookup_module artifacts name with + | None -> does_not_exist ~what:"Module" (Module_name.to_string name) + | Some (t, m) -> + (match Obj_dir.Module.cm_file t m ~kind:(Ocaml kind) with + | None -> Action_builder.return [ Value.String "" ] + | Some path -> dep (Path.build path))) + | Lib mode -> + let name = Lib_name.parse_string_exn (Dune_lang.Template.Pform.loc source, name) in + (match Artifacts_obj.lookup_library artifacts name with + | None -> does_not_exist ~what:"Library" (Lib_name.to_string name) + | Some lib -> + Mode.Dict.get (Lib_info.archives lib) mode + |> Action_builder.List.map ~f:(fun fn -> + let fn = Path.build fn in + let+ () = Action_builder.path fn in + Value.Path fn)) ;; let foreign_flags = Fdecl.create Dyn.opaque @@ -764,7 +759,6 @@ let make_root ; lib_artifacts_host ; artifacts_host ; context - ; lookup_artifacts = None ; expanding_what = Nothing_special } ;; diff --git a/src/dune_rules/expander.mli b/src/dune_rules/expander.mli index a4dbabcb0d1..2ba9afce7b0 100644 --- a/src/dune_rules/expander.mli +++ b/src/dune_rules/expander.mli @@ -21,7 +21,6 @@ val set_local_env_var : t -> var:string -> value:string Action_builder.t -> t val set_dir : t -> dir:Path.Build.t -> t val set_scope : t -> scope:Scope.t -> scope_host:Scope.t -> t val set_artifacts : t -> artifacts_host:Artifacts.t -> t -val set_lookup_ml_sources : t -> f:(dir:Path.Build.t -> Artifacts_obj.t Memo.t) -> t module Expanding_what : sig type t = @@ -141,3 +140,5 @@ val expand_locks val foreign_flags : (dir:Path.Build.t -> string list Action_builder.t Foreign_language.Dict.t Memo.t) Fdecl.t + +val lookup_artifacts : (dir:Path.Build.t -> Artifacts_obj.t Memo.t) Fdecl.t diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index c64f696d711..bb39f7eda1d 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -302,11 +302,9 @@ let gen_format_and_cram_rules sctx ~expander ~dir source_dir = let gen_rules_source_only sctx ~dir source_dir = Rules.collect_unit (fun () -> let* sctx = sctx in - let* expander = - let+ expander = Super_context.expander sctx ~dir in - Dir_contents.add_sources_to_expander sctx expander - in - let+ () = gen_format_and_cram_rules sctx ~expander ~dir source_dir + let+ () = + let* expander = Super_context.expander sctx ~dir in + gen_format_and_cram_rules sctx ~expander ~dir source_dir and+ () = define_all_alias ~dir ~js_targets:[] ~project:(Source_tree.Dir.project source_dir) in @@ -316,10 +314,7 @@ let gen_rules_source_only sctx ~dir source_dir = let gen_rules_group_part_or_root sctx dir_contents cctxs ~source_dir ~dir : (Loc.t * Compilation_context.t) list Memo.t = - let* expander = - let+ expander = Super_context.expander sctx ~dir in - Dir_contents.add_sources_to_expander sctx expander - in + let* expander = Super_context.expander sctx ~dir in let* () = gen_format_and_cram_rules sctx ~expander ~dir source_dir and+ stanzas = (* CR-soon rgrinberg: we shouldn't have to fetch the stanzas yet again *) diff --git a/test/blackbox-tests/test-cases/variables-for-artifacts.t/run.t b/test/blackbox-tests/test-cases/variables-for-artifacts.t/run.t index 673b94041bb..5d9d5697454 100644 --- a/test/blackbox-tests/test-cases/variables-for-artifacts.t/run.t +++ b/test/blackbox-tests/test-cases/variables-for-artifacts.t/run.t @@ -191,7 +191,11 @@ This test checks error handling. $ dune build %{cma:../x} File "command line", line 1, characters 0-11: - Error: Library x does not exist. + Error: cannot escape the workspace root directory + [1] + $ dune build %{cma:../../x} + Error: path outside the workspace: ../../x from default + -> required by %{cma:../../x} at command line:1 [1] This test checks that everything still works if we invoke dune from a