From 886df09f605c2ecc12ac9a1829275602f9e18032 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Mon, 5 Jun 2023 18:11:36 +0200 Subject: [PATCH] Revert #7415 and #7450 (#7887) * Revert "fix(x-compilation): delay evaluation of `ppx_runtime_deps` until context is known" This reverts commit ab74a71dc04380ed592462f982ceb4dd6371203f. Signed-off-by: Etienne Millon * Revert "test(x-compilation): demonstrate overlap check failure with ppx_runtime_libraries" This reverts commit 096fc97ea5a8734186a9fb7ae080326526fd7bf7. Signed-off-by: Etienne Millon * Revert "fix(x-compilation): find host ppx dependencies in the host context (#7415)" This reverts commit 16a7e883ef2b2283f8a636fbf2c8bade3da92754. Signed-off-by: Etienne Millon * Changelog Signed-off-by: Etienne Millon --------- Signed-off-by: Etienne Millon --- CHANGES.md | 5 +- src/dune_rules/buildable_rules.ml | 5 +- src/dune_rules/cinaps.ml | 2 +- src/dune_rules/expander.ml | 2 - src/dune_rules/expander.mli | 2 - src/dune_rules/jsoo/jsoo_rules.ml | 2 +- src/dune_rules/lib.ml | 199 ++++++------------ src/dune_rules/lib.mli | 3 +- src/dune_rules/preprocessing.ml | 3 +- src/dune_rules/preprocessing.mli | 1 + src/dune_rules/scope.ml | 89 +++----- src/dune_rules/toplevel.ml | 2 +- src/dune_rules/utop.ml | 2 +- .../ppx-cross-context-issue.t/run.t | 28 ++- .../ppx-runtime-libraries.t | 60 ------ .../ppx-runtime-dependencies.t/run.t | 10 +- 16 files changed, 123 insertions(+), 292 deletions(-) delete mode 100644 test/blackbox-tests/test-cases/custom-cross-compilation/ppx-runtime-libraries.t diff --git a/CHANGES.md b/CHANGES.md index 9147903c149..b16d84a84f7 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -26,6 +26,9 @@ Unreleased - The `interface` and `implementation` fields of a `(dialect)` are now optional (#7757, @gpetiot) +- Revert #7415 and #7450 (Resolve `ppx_runtime_libraries` in the target context when + cross compiling) (#7887, fixes #7875, @emillon) + 3.8.0 (2023-05-23) ------------------ @@ -82,7 +85,7 @@ Unreleased - Fix `dune install` when cross compiling (#7410, fixes #6191, @anmonteiro, @rizo) -- Find `pps` dependencies in the host context when cross-compiling, (#7410, +- Find `pps` dependencies in the host context when cross-compiling, (#7415, fixes #4156, @anmonteiro) - Dune in watch mode no longer builds concurrent rules in serial (#7395 diff --git a/src/dune_rules/buildable_rules.ml b/src/dune_rules/buildable_rules.ml index 56d7f053aa4..7cf1ba7e5ac 100644 --- a/src/dune_rules/buildable_rules.ml +++ b/src/dune_rules/buildable_rules.ml @@ -56,8 +56,9 @@ let modules_rules ~preprocess ~preprocessor_deps ~lint (Preprocess.Per_module.instrumentation_deps preprocess ~instrumentation_backend) in - Preprocessing.make sctx ~dir ~preprocess:preprocess_with_instrumentation - ~expander ~preprocessor_deps ~instrumentation_deps ~lint ~lib_name + Preprocessing.make sctx ~dir ~scope + ~preprocess:preprocess_with_instrumentation ~expander ~preprocessor_deps + ~instrumentation_deps ~lint ~lib_name in let add_empty_intf = let default = empty_module_interface_if_absent in diff --git a/src/dune_rules/cinaps.ml b/src/dune_rules/cinaps.ml index 576807535ee..ab4fe93542c 100644 --- a/src/dune_rules/cinaps.ml +++ b/src/dune_rules/cinaps.ml @@ -120,7 +120,7 @@ let gen_rules sctx t ~dir ~scope = Preprocessing.make sctx ~dir ~expander ~lint:(Preprocess.Per_module.no_preprocessing ()) ~preprocess:t.preprocess ~preprocessor_deps:t.preprocessor_deps - ~instrumentation_deps:[] ~lib_name:None + ~instrumentation_deps:[] ~lib_name:None ~scope in let* modules = Modules.singleton_exe module_ diff --git a/src/dune_rules/expander.ml b/src/dune_rules/expander.ml index d1a3e673ec2..8721ee5bd75 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -65,8 +65,6 @@ type t = let scope t = t.scope -let scope_host t = t.scope_host - let artifacts t = t.bin_artifacts_host let dir t = t.dir diff --git a/src/dune_rules/expander.mli b/src/dune_rules/expander.mli index 2b8dfc6f164..bbe16aa73f7 100644 --- a/src/dune_rules/expander.mli +++ b/src/dune_rules/expander.mli @@ -6,8 +6,6 @@ type t val scope : t -> Scope.t -val scope_host : t -> Scope.t - val dir : t -> Path.Build.t val context : t -> Context.t diff --git a/src/dune_rules/jsoo/jsoo_rules.ml b/src/dune_rules/jsoo/jsoo_rules.ml index 028b2187cd7..952bc4a9d13 100644 --- a/src/dune_rules/jsoo/jsoo_rules.ml +++ b/src/dune_rules/jsoo/jsoo_rules.ml @@ -355,7 +355,7 @@ let setup_separate_compilation_rules sctx components = let pkg = Lib_name.parse_string_exn (Loc.none, s_pkg) in let ctx = Super_context.context sctx in let open Memo.O in - let* installed_libs = Lib.DB.installed ~host:None ctx in + let* installed_libs = Lib.DB.installed ctx in Lib.DB.find installed_libs pkg >>= function | None -> Memo.return () | Some pkg -> diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 33e9f28944f..d8b1650cded 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -299,7 +299,7 @@ module T = struct ; (* [requires] is contains all required libraries, including the ones mentioned in [re_exports]. *) requires : t list Resolve.t - ; ppx_runtime_deps_host : t list Resolve.t Memo.Lazy.t + ; ppx_runtime_deps : t list Resolve.t ; pps : t list Resolve.t ; resolved_selects : Resolved_select.t list Resolve.t ; implements : t Resolve.t option @@ -353,30 +353,6 @@ module Hidden = struct { lib = info; reason = "unsatisfied 'exist_if'"; path } end -module Private_deps = struct - type t = - | From_same_project of [ `Public | `Private_package ] - | Allow_all - - let equal a b = - match (a, b) with - | Allow_all, Allow_all - | From_same_project `Public, From_same_project `Public - | From_same_project `Private_package, From_same_project `Private_package -> - true - | _ -> false - - let check t ~loc ~lib = - match t with - | Allow_all -> Ok lib - | From_same_project kind -> ( - match Lib_info.status lib.info with - | Private (_, Some _) -> Ok lib - | Private (_, None) -> - Error (Error.private_deps_not_allowed ~kind ~loc lib.info) - | _ -> Ok lib) -end - module Status = struct type t = | Found of lib @@ -396,10 +372,7 @@ end type db = { parent : db option - ; host : db Memo.Lazy.t option ; resolve : Lib_name.t -> resolve_result Memo.t - ; resolve_ppx_runtime_deps : - (Path.t Lib_info.t * Private_deps.t, t list Resolve.t) Memo.Table.t ; all : Lib_name.t list Memo.Lazy.t ; lib_config : Lib_config.t } @@ -425,7 +398,7 @@ let implements t = Option.map ~f:Memo.return t.implements let requires t = Memo.return t.requires -let ppx_runtime_deps t = Memo.Lazy.force t.ppx_runtime_deps_host +let ppx_runtime_deps t = Memo.return t.ppx_runtime_deps let pps t = Memo.return t.pps @@ -629,6 +602,20 @@ end = struct { stack = x :: t.stack; seen = Id.Set.add t.seen x; implements_via } end +type private_deps = + | From_same_project of [ `Public | `Private_package ] + | Allow_all + +let check_private_deps lib ~loc ~(private_deps : private_deps) = + match private_deps with + | Allow_all -> Ok lib + | From_same_project kind -> ( + match Lib_info.status lib.info with + | Private (_, Some _) -> Ok lib + | Private (_, None) -> + Error (Error.private_deps_not_allowed ~kind ~loc lib.info) + | _ -> Ok lib) + module Vlib : sig (** Make sure that for every virtual library in the list there is at most one corresponding implementation. @@ -788,10 +775,7 @@ module rec Resolve_names : sig val find_internal : db -> Lib_name.t -> Status.t Memo.t val resolve_dep : - db - -> Loc.t * Lib_name.t - -> private_deps:Private_deps.t - -> lib Resolve.Memo.t + db -> Loc.t * Lib_name.t -> private_deps:private_deps -> lib Resolve.Memo.t val resolve_name : db -> Lib_name.t -> Status.t Memo.t @@ -800,7 +784,7 @@ module rec Resolve_names : sig val resolve_simple_deps : db -> (Loc.t * Lib_name.t) list - -> private_deps:Private_deps.t + -> private_deps:private_deps -> t list Resolve.Memo.t type resolved = @@ -813,7 +797,7 @@ module rec Resolve_names : sig val resolve_deps_and_add_runtime_deps : db -> Lib_dep.t list - -> private_deps:Private_deps.t + -> private_deps:private_deps -> pps:(Loc.t * Lib_name.t) list -> dune_version:Dune_lang.Syntax.Version.t option -> resolved Memo.t @@ -846,13 +830,13 @@ end = struct let instantiate_impl (db, name, info, hidden) = let open Memo.O in let unique_id = Id.make ~name ~path:(Lib_info.src_dir info) in + let status = Lib_info.status info in let private_deps = - match Lib_info.status info with + match status with (* [Allow_all] is used for libraries that are installed because we don't have to check it again. It has been checked when compiling the libraries before their installation *) - | Installed_private | Private (_, None) | Installed -> - Private_deps.Allow_all + | Installed_private | Private (_, None) | Installed -> Allow_all | Private (_, Some _) -> From_same_project `Private_package | Public (_, _) -> From_same_project `Public in @@ -962,17 +946,16 @@ end = struct let+ impl = impl in impl :: requires) in + let* ppx_runtime_deps = + Lib_info.ppx_runtime_deps info |> resolve_simple_deps db ~private_deps + in + let src_dir = Lib_info.src_dir info in let map_error x = - let src_dir = Lib_info.src_dir info in Resolve.push_stack_frame x ~human_readable_description:(fun () -> Dep_path.Entry.Lib.pp { name; path = src_dir }) in - let ppx_runtime_deps_host = - Memo.lazy_ (fun () -> - Memo.exec db.resolve_ppx_runtime_deps (info, private_deps) - |> Memo.map ~f:map_error) - in let requires = map_error requires in + let ppx_runtime_deps = map_error ppx_runtime_deps in let* project = let status = Lib_info.status info in match Lib_info.Status.project status with @@ -993,7 +976,7 @@ end = struct ; name ; unique_id ; requires - ; ppx_runtime_deps_host + ; ppx_runtime_deps ; pps ; resolved_selects ; re_exports @@ -1009,25 +992,27 @@ end = struct }) in let t = Lazy.force t in - let+ hidden = + let res = + let hidden = + match hidden with + | Some _ -> hidden + | None -> ( + let enabled = Lib_info.enabled info in + match enabled with + | Normal -> None + | Disabled_because_of_enabled_if -> Some "unsatisfied 'enabled_if'" + | Optional -> + (* TODO this could be made lazier *) + let requires = Resolve.is_ok requires in + let ppx_runtime_deps = Resolve.is_ok t.ppx_runtime_deps in + if requires && ppx_runtime_deps then None + else Some "optional with unavailable dependencies") + in match hidden with - | Some _ -> Memo.return hidden - | None -> ( - let enabled = Lib_info.enabled info in - match enabled with - | Normal -> Memo.return None - | Disabled_because_of_enabled_if -> - Memo.return (Some "unsatisfied 'enabled_if'") - | Optional -> - (* TODO this could be made lazier *) - let requires = Resolve.is_ok requires in - let+ ppx_runtime_deps = ppx_runtime_deps t >>| Resolve.is_ok in - if requires && ppx_runtime_deps then None - else Some "optional with unavailable dependencies") + | None -> Status.Found t + | Some reason -> Hidden (Hidden.of_lib t ~reason) in - match hidden with - | None -> Status.Found t - | Some reason -> Hidden (Hidden.of_lib t ~reason) + Memo.return res let memo = let module Input = struct @@ -1057,7 +1042,7 @@ end = struct let open Memo.O in find_internal db name >>= function | Found lib -> - Resolve.Memo.of_result (Private_deps.check private_deps ~loc ~lib) + Resolve.Memo.of_result (check_private_deps lib ~loc ~private_deps) | Not_found -> Error.not_found ~loc ~name | Invalid why -> Resolve.Memo.of_result (Error why) | Hidden h -> Hidden.error h ~loc ~name @@ -1298,20 +1283,8 @@ end = struct in let pps = let* pps = - let open Memo.O in - let* db_host = - match db.host with - | None -> Memo.return db - | Some host -> - (* PPXes run in the host context, so their dependencies have to - be resolved accordingly. *) - Memo.Lazy.force host - in Resolve.Memo.List.map pps ~f:(fun (loc, name) -> - let open Resolve.Memo.O in - let* lib = - resolve_dep db_host (loc, name) ~private_deps:Allow_all - in + let* lib = resolve_dep db (loc, name) ~private_deps:Allow_all in match (allow_only_ppx_deps, Lib_info.kind lib.info) with | true, Normal -> Error.only_ppx_deps_allowed ~loc lib.info | _ -> Resolve.Memo.return lib) @@ -1321,25 +1294,12 @@ end = struct in let runtime_deps = let* pps = pps in - Resolve.Memo.List.concat_map pps ~f:(fun pp -> - let* ppx_runtime_deps = - match db.host with - | None -> ppx_runtime_deps pp - | Some _host -> - (* (ppx_runtime_libraries ...) run in the target context, so - these dependencies need to be resolved here rather than at - instantiation of the ppx library (in the host context). *) - Memo.exec db.resolve_ppx_runtime_deps (pp.info, private_deps) - |> Memo.map ~f:(fun x -> - Resolve.push_stack_frame x - ~human_readable_description:(fun () -> - Dep_path.Entry.Lib.pp - { name = pp.name; path = Lib_info.src_dir pp.info })) - in + Resolve.List.concat_map pps ~f:(fun pp -> + let open Resolve.O in + let* ppx_runtime_deps = pp.ppx_runtime_deps in Resolve.List.map ppx_runtime_deps ~f:(fun dep -> - Private_deps.check private_deps ~lib:dep ~loc - |> Resolve.of_result) - |> Memo.return) + check_private_deps ~loc ~private_deps dep |> Resolve.of_result)) + |> Memo.return in { runtime_deps; pps } @@ -1665,7 +1625,7 @@ let descriptive_closure (l : lib list) ~with_pps : lib list Memo.t = let* todo = if with_pps then register_work todo lib.pps else Memo.return todo in - let* todo = ppx_runtime_deps lib >>= register_work todo in + let* todo = register_work todo lib.ppx_runtime_deps in let* todo = register_work todo lib.requires in work todo acc in @@ -1765,47 +1725,12 @@ module DB = struct type t = db - let create = - let module Input = struct - type t = Path.t Lib_info.t * Private_deps.t - - let to_dyn = Dyn.opaque - - let hash x = Poly.hash x - - let equal (t, private_deps) (t', private_deps') = - equal t t' && Private_deps.equal private_deps private_deps' - end in - let resolve_ppx_runtime_deps db = - let resolve_ppx_runtime_deps_impl (info, private_deps) = - Resolve_names.resolve_simple_deps (Lazy.force db) - (Lib_info.ppx_runtime_deps info) - ~private_deps - in - Memo.create "lib-resolve-ppx-runtime-libraries" - ~input:(module Input) - resolve_ppx_runtime_deps_impl - ~human_readable_description:(fun (info, _private_deps) -> - Dep_path.Entry.Lib.pp - { name = Lib_info.name info; path = Lib_info.src_dir info }) - in - (* TODO: unneeded unit argument *) - fun ~parent ~host ~resolve ~all ~lib_config () -> - let rec db = - lazy - { parent - ; host - ; resolve - ; resolve_ppx_runtime_deps = resolve_ppx_runtime_deps db - ; all = Memo.lazy_ all - ; lib_config - } - in - Lazy.force db + let create ~parent ~resolve ~all ~lib_config () = + { parent; resolve; all = Memo.lazy_ all; lib_config } - let create_from_findlib ~host findlib = + let create_from_findlib findlib = let lib_config = Findlib.lib_config findlib in - create () ~parent:None ~host ~lib_config + create () ~parent:None ~lib_config ~resolve:(fun name -> let open Memo.O in Findlib.find findlib name >>| function @@ -1821,12 +1746,12 @@ module DB = struct let open Memo.O in Findlib.all_packages findlib >>| List.map ~f:Dune_package.Entry.name) - let installed (context : Context.t) ~host = + let installed (context : Context.t) = let open Memo.O in let+ findlib = Findlib.create ~paths:context.findlib_paths ~lib_config:context.lib_config in - create_from_findlib ~host findlib + create_from_findlib findlib let find t name = let open Memo.O in @@ -1996,7 +1921,7 @@ let to_dune_lib ({ info; _ } as lib) ~modules ~foreign_objects use_public_name ~info_field:(Lib_info.default_implementation info) ~lib_field:(Option.map ~f:Memo.Lazy.force lib.default_implementation) - and+ ppx_runtime_deps = ppx_runtime_deps lib + and+ ppx_runtime_deps = Memo.return lib.ppx_runtime_deps and+ requires = Memo.return lib.requires and+ re_exports = Memo.return lib.re_exports in let ppx_runtime_deps = add_loc ppx_runtime_deps in diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 87ea08d4fe2..5cd3f440a07 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -99,7 +99,7 @@ module DB : sig (** A database allow to resolve library names *) type t = db - val installed : Context.t -> host:t Memo.Lazy.t option -> t Memo.t + val installed : Context.t -> t Memo.t module Resolve_result : sig type db := t @@ -124,7 +124,6 @@ module DB : sig [all] returns the list of names of libraries available in this database. *) val create : parent:t option - -> host:t Memo.Lazy.t option -> resolve:(Lib_name.t -> Resolve_result.t Memo.t) -> all:(unit -> Lib_name.t list Memo.t) -> lib_config:Lib_config.t diff --git a/src/dune_rules/preprocessing.ml b/src/dune_rules/preprocessing.ml index 1c422de63df..14c83616e07 100644 --- a/src/dune_rules/preprocessing.ml +++ b/src/dune_rules/preprocessing.ml @@ -715,8 +715,7 @@ let pp_one_module sctx ~lib_name ~scope ~preprocessor_deps >>| Action.Full.add_sandbox sandbox)))) let make sctx ~dir ~expander ~lint ~preprocess ~preprocessor_deps - ~instrumentation_deps ~lib_name = - let scope = Expander.scope_host expander in + ~instrumentation_deps ~lib_name ~scope = let preprocessor_deps = preprocessor_deps @ instrumentation_deps in let preprocess = Module_name.Per_item.map preprocess ~f:(fun pp -> diff --git a/src/dune_rules/preprocessing.mli b/src/dune_rules/preprocessing.mli index da177e0e0c2..9e97eb77191 100644 --- a/src/dune_rules/preprocessing.mli +++ b/src/dune_rules/preprocessing.mli @@ -16,6 +16,7 @@ val make : -> preprocessor_deps:Dep_conf.t list -> instrumentation_deps:Dep_conf.t list -> lib_name:Lib_name.Local.t option + -> scope:Scope.t -> Pp_spec.t (** Get a path to a cached ppx driver with some extra flags for cookies. *) diff --git a/src/dune_rules/scope.ml b/src/dune_rules/scope.ml index ef740e2b69f..c76ec5ca36d 100644 --- a/src/dune_rules/scope.ml +++ b/src/dune_rules/scope.ml @@ -77,7 +77,7 @@ module DB = struct | Deprecated_library_name of Dune_file.Deprecated_library_name.t end - let create_db_from_stanzas ~parent ~lib_config ~host stanzas = + let create_db_from_stanzas ~parent ~lib_config stanzas = let open Memo.O in let+ (map : Found_or_redirect.t Lib_name.Map.t) = Memo.List.map stanzas ~f:(fun stanza -> @@ -132,7 +132,7 @@ module DB = struct ; Pp.textf "- %s" (Loc.to_file_colon_line loc2) ]) in - Lib.DB.create () ~parent:(Some parent) ~host + Lib.DB.create () ~parent:(Some parent) ~resolve:(fun name -> Memo.return (match Lib_name.Map.find map name with @@ -163,7 +163,7 @@ module DB = struct ~parent:(Some installed_theories) (* Create a database from the public libraries defined in the stanzas *) - let public_libs t ~installed_libs ~lib_config ~host stanzas = + let public_libs t ~installed_libs ~lib_config stanzas = let public_libs = List.filter_map stanzas ~f:(fun (stanza : Library_related_stanza.t) -> match stanza with @@ -211,7 +211,7 @@ module DB = struct ]) in let resolve lib = Memo.return (resolve t public_libs lib) in - Lib.DB.create ~parent:(Some installed_libs) ~host ~resolve + Lib.DB.create ~parent:(Some installed_libs) ~resolve ~all:(fun () -> Lib_name.Map.keys public_libs |> Memo.return) ~lib_config () @@ -241,8 +241,8 @@ module DB = struct |> Coq_lib.DB.create_from_coqlib_stanzas ~parent ~find_db |> Option.some) - let rec scopes_by_dir ~host_context ~build_dir ~lib_config ~projects - ~public_libs ~public_theories stanzas coq_stanzas = + let scopes_by_dir ~build_dir ~lib_config ~projects ~public_libs + ~public_theories stanzas coq_stanzas = let open Memo.O in let projects_by_dir = Path.Source.Map.of_list_map_exn projects ~f:(fun project -> @@ -267,20 +267,8 @@ module DB = struct Some (project, stanzas)) |> Path_source_map_traversals.parallel_map ~f:(fun _dir (project, stanzas) -> - let host = - Option.map host_context ~f:(fun host_context -> - Memo.Lazy.create @@ fun () -> - let+ scope = - let+ scopes, _public_libs_host = - create_from_stanzas host_context - in - find_by_project scopes project - in - scope.db) - in let+ db = - create_db_from_stanzas stanzas ~parent:public_libs ~host - ~lib_config + create_db_from_stanzas stanzas ~parent:public_libs ~lib_config in (project, db)) in @@ -300,34 +288,14 @@ module DB = struct let coq_db = coq_db_find dir in { project; db; coq_db; root }) - and create ~(context : Context.t) ~projects stanzas coq_stanzas = + let create ~(context : Context.t) ~projects stanzas coq_stanzas = let open Memo.O in let t = Fdecl.create Dyn.opaque in let build_dir = context.build_dir in let lib_config = Context.lib_config context in - let* public_libs, host_context = - let host_context = - let host_context = Context.host context in - Option.some_if (not (Context.equal context host_context)) host_context - in - let+ public_libs = - match host_context with - | None -> - let+ installed_libs = Lib.DB.installed ~host:None context in - public_libs t ~lib_config ~installed_libs ~host:None stanzas - | Some host_context -> - let host = - let host = - Memo.Lazy.create @@ fun () -> - let+ installed_libs = Lib.DB.installed ~host:None host_context in - public_libs t ~lib_config ~installed_libs ~host:None stanzas - in - Some host - in - let+ installed_libs = Lib.DB.installed ~host context in - public_libs t ~lib_config ~installed_libs ~host stanzas - in - (public_libs, host_context) + let* public_libs = + let+ installed_libs = Lib.DB.installed context in + public_libs t ~lib_config ~installed_libs stanzas in let public_theories = let installed_theories = @@ -342,14 +310,14 @@ module DB = struct ~installed_theories coq_stanzas) in let+ by_dir = - scopes_by_dir ~host_context ~build_dir ~lib_config ~projects ~public_libs + scopes_by_dir ~build_dir ~lib_config ~projects ~public_libs ~public_theories stanzas coq_stanzas in let value = { by_dir } in Fdecl.set t value; (value, public_libs) - and from_stanzas ~projects ~(context : Context.t) stanzas = + let create_from_stanzas ~projects ~(context : Context.t) stanzas = let stanzas, coq_stanzas = Dune_file.fold_stanzas stanzas ~init:([], []) ~f:(fun dune_file stanza (acc, coq_acc) -> @@ -371,23 +339,22 @@ module DB = struct in create ~projects ~context stanzas coq_stanzas - and all = - lazy - ( Memo.Lazy.create @@ fun () -> - let+ contexts = Context.DB.all () in - Context_name.Map.of_list_map_exn contexts ~f:(fun context -> - let scopes = - Memo.Lazy.create @@ fun () -> - let* { Dune_load.dune_files = _; packages = _; projects } = - Dune_load.load () - in - let* stanzas = Only_packages.filtered_stanzas context in - from_stanzas ~projects ~context stanzas - in - (context.name, scopes)) ) + let all = + Memo.Lazy.create @@ fun () -> + let+ contexts = Context.DB.all () in + Context_name.Map.of_list_map_exn contexts ~f:(fun context -> + let scopes = + Memo.Lazy.create @@ fun () -> + let* { Dune_load.dune_files = _; packages = _; projects } = + Dune_load.load () + in + let* stanzas = Only_packages.filtered_stanzas context in + create_from_stanzas ~projects ~context stanzas + in + (context.name, scopes)) - and create_from_stanzas (context : Context.t) = - let* all = Memo.Lazy.force (Lazy.force all) in + let create_from_stanzas (context : Context.t) = + let* all = Memo.Lazy.force all in Context_name.Map.find_exn all context.name |> Memo.Lazy.force let with_all context ~f = diff --git a/src/dune_rules/toplevel.ml b/src/dune_rules/toplevel.ml index d9bb2576874..5659027ade0 100644 --- a/src/dune_rules/toplevel.ml +++ b/src/dune_rules/toplevel.ml @@ -163,7 +163,7 @@ module Stanza = struct in let preprocessing = let preprocess = Module_name.Per_item.for_all toplevel.pps in - Preprocessing.make sctx ~dir ~expander ~lib_name:None + Preprocessing.make sctx ~dir ~expander ~scope ~lib_name:None ~lint:Dune_file.Lint.no_lint ~preprocess ~preprocessor_deps:[] ~instrumentation_deps:[] in diff --git a/src/dune_rules/utop.ml b/src/dune_rules/utop.ml index 3102db8c54f..3ce0f1f6b31 100644 --- a/src/dune_rules/utop.ml +++ b/src/dune_rules/utop.ml @@ -143,7 +143,7 @@ let setup sctx ~dir = in let preprocessing = let preprocess = Module_name.Per_item.for_all pps in - Preprocessing.make sctx ~dir ~expander ~lib_name:None + Preprocessing.make sctx ~dir ~expander ~scope ~lib_name:None ~lint:Dune_file.Lint.no_lint ~preprocess ~preprocessor_deps:[] ~instrumentation_deps:[] in diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-cross-context-issue.t/run.t b/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-cross-context-issue.t/run.t index 1ecee22e5fc..05cf21797f8 100644 --- a/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-cross-context-issue.t/run.t +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-cross-context-issue.t/run.t @@ -1,16 +1,12 @@ -Dune uses the host context to look up dependencies and build PPXes - - $ dune build - -PPX is only built in the host context - - $ ls _build/cross-environment/ppx - dune - fooppx.ml - $ ls _build/default/ppx - dune - fooppx.a - fooppx.cma - fooppx.cmxa - fooppx.cmxs - fooppx.ml +# Using a ppx in a cross-compiled build context makes dune try to build the ppx +# in the target context instead of the host, then fail. + $ dune build --debug-dependency-path + File "lib/dune", line 3, characters 18-24: + 3 | (preprocess (pps fooppx))) + ^^^^^^ + Error: Library "fooppx" in _build/cross-environment/ppx is hidden + (unsatisfied 'enabled_if'). + -> required by _build/cross-environment/lib/lib.pp.ml + -> required by alias lib/all (context cross-environment) + -> required by alias default (context cross-environment) + [1] diff --git a/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-runtime-libraries.t b/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-runtime-libraries.t deleted file mode 100644 index 971bc0372b7..00000000000 --- a/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-runtime-libraries.t +++ /dev/null @@ -1,60 +0,0 @@ -Demonstrate a bad interaction between cross-compilation and -ppx_runtime_libraries - - $ mkdir -p etc/findlib.conf.d - $ export OCAMLFIND_CONF=$PWD/etc/findlib.conf - $ touch etc/findlib.conf etc/findlib.conf.d/foo.conf - -Create lib1, ppx and lib2: -- lib1 is a regular library -- ppx has a runtime dep on lib1 (via `ppx_runtime_libraries`) -- lib2 is a regular library pre-processed by `ppx` - - $ mkdir lib1 ppx lib2 - $ cat > dune-project < (lang dune 3.7) - > (package (name ppx-cross)) - > EOF - - $ cat > lib1/dune < (library - > (name lib1) - > (public_name ppx-cross.lib1)) - > EOF - -In the ppx, removing `ppx_runtime_libraries` makes the test pass - - $ cat > ppx/dune < (library - > (name ppx) - > (public_name ppx-cross.ppx) - > (kind ppx_rewriter) - > (ppx.driver (main Ppx.main)) - > (ppx_runtime_libraries lib1)) - > EOF - $ cat > ppx/ppx.ml < let main () = - > let out = ref "" in - > let args = - > [ ("-o", Arg.Set_string out, "") - > ; ("--impl", Arg.Set_string (ref ""), "") - > ; ("--as-ppx", Arg.Set (ref false), "") - > ; ("--cookie", Arg.Set (ref false), "") - > ] - > in - > let anon _ = () in - > Arg.parse (Arg.align args) anon ""; - > let out = open_out !out in - > close_out out; - > EOF - - $ cat > lib2/dune < (library - > (name lib2) - > (public_name ppx-cross.lib2) - > (preprocess (pps ppx))) - > EOF - $ touch lib2/lib2.ml - - $ dune build @install -x foo - diff --git a/test/blackbox-tests/test-cases/ppx-runtime-dependencies.t/run.t b/test/blackbox-tests/test-cases/ppx-runtime-dependencies.t/run.t index 3c57cb66e89..d0796bcfd73 100644 --- a/test/blackbox-tests/test-cases/ppx-runtime-dependencies.t/run.t +++ b/test/blackbox-tests/test-cases/ppx-runtime-dependencies.t/run.t @@ -8,8 +8,7 @@ Handling ppx_runtime_libraries dependencies correctly $ chmod +x sdune ---------------------------------------------------------------------------------- -ppx_runtime_libraries detection is delayed until they're used so this doesn't -cause a dependency cycle +* Incorrect cycle detection due to ppx_runtime_libraries (TODO: fix this bug!) $ cat >dune-project < (lang dune 2.0) @@ -60,7 +59,12 @@ cause a dependency cycle > EOF $ ./sdune exec bin/main.exe - Should print 3: 3 + Error: Dependency cycle between: + library "b" in _build/default + -> library "a" in _build/default + -> library "c" in _build/default + -> library "b" in _build/default + [1] ---------------------------------------------------------------------------------- * Ppx rewriters (and their ppx_runtime_libraries information) are collected recursively