diff --git a/CHANGES.md b/CHANGES.md index b16d84a84f70..9147903c149a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -26,9 +26,6 @@ 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) ------------------ @@ -85,7 +82,7 @@ Unreleased - Fix `dune install` when cross compiling (#7410, fixes #6191, @anmonteiro, @rizo) -- Find `pps` dependencies in the host context when cross-compiling, (#7415, +- Find `pps` dependencies in the host context when cross-compiling, (#7410, 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 7cf1ba7e5ac8..56d7f053aa4d 100644 --- a/src/dune_rules/buildable_rules.ml +++ b/src/dune_rules/buildable_rules.ml @@ -56,9 +56,8 @@ let modules_rules ~preprocess ~preprocessor_deps ~lint (Preprocess.Per_module.instrumentation_deps preprocess ~instrumentation_backend) in - Preprocessing.make sctx ~dir ~scope - ~preprocess:preprocess_with_instrumentation ~expander ~preprocessor_deps - ~instrumentation_deps ~lint ~lib_name + Preprocessing.make sctx ~dir ~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 ab4fe93542c6..576807535eeb 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 ~scope + ~instrumentation_deps:[] ~lib_name:None in let* modules = Modules.singleton_exe module_ diff --git a/src/dune_rules/expander.ml b/src/dune_rules/expander.ml index 8721ee5bd750..d1a3e673ec24 100644 --- a/src/dune_rules/expander.ml +++ b/src/dune_rules/expander.ml @@ -65,6 +65,8 @@ 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 bbe16aa73f75..2b8dfc6f164c 100644 --- a/src/dune_rules/expander.mli +++ b/src/dune_rules/expander.mli @@ -6,6 +6,8 @@ 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 952bc4a9d138..028b2187cd7e 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 ctx in + let* installed_libs = Lib.DB.installed ~host:None 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 7fa87d4951f4..1ebbb152fe55 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 : t list Resolve.t + ; ppx_runtime_deps_host : t list Resolve.t Memo.Lazy.t ; pps : t list Resolve.t ; resolved_selects : Resolved_select.t list Resolve.t ; implements : t Resolve.t option @@ -353,6 +353,30 @@ 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 @@ -372,7 +396,10 @@ 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 } @@ -398,7 +425,7 @@ let implements t = Option.map ~f:Memo.return t.implements let requires t = Memo.return t.requires -let ppx_runtime_deps t = Memo.return t.ppx_runtime_deps +let ppx_runtime_deps t = Memo.Lazy.force t.ppx_runtime_deps_host let pps t = Memo.return t.pps @@ -602,20 +629,6 @@ 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. @@ -775,7 +788,10 @@ 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 -> lib Resolve.Memo.t + db + -> Loc.t * Lib_name.t + -> private_deps:Private_deps.t + -> lib Resolve.Memo.t val resolve_name : db -> Lib_name.t -> Status.t Memo.t @@ -784,7 +800,7 @@ module rec Resolve_names : sig val resolve_simple_deps : db -> (Loc.t * Lib_name.t) list - -> private_deps:private_deps + -> private_deps:Private_deps.t -> t list Resolve.Memo.t type resolved = @@ -797,7 +813,7 @@ module rec Resolve_names : sig val resolve_deps_and_add_runtime_deps : db -> Lib_dep.t list - -> private_deps:private_deps + -> private_deps:Private_deps.t -> pps:(Loc.t * Lib_name.t) list -> dune_version:Dune_lang.Syntax.Version.t option -> resolved Memo.t @@ -830,13 +846,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 status with + match Lib_info.status info 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 -> Allow_all + | Installed_private | Private (_, None) | Installed -> + Private_deps.Allow_all | Private (_, Some _) -> From_same_project `Private_package | Public (_, _) -> From_same_project `Public in @@ -946,16 +962,17 @@ 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 @@ -976,7 +993,7 @@ end = struct ; name ; unique_id ; requires - ; ppx_runtime_deps + ; ppx_runtime_deps_host ; pps ; resolved_selects ; re_exports @@ -992,27 +1009,25 @@ end = struct }) in let t = Lazy.force t in - 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 + let+ hidden = match hidden with - | None -> Status.Found t - | Some reason -> Hidden (Hidden.of_lib t ~reason) + | 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") in - Memo.return res + match hidden with + | None -> Status.Found t + | Some reason -> Hidden (Hidden.of_lib t ~reason) let memo = let module Input = struct @@ -1042,7 +1057,7 @@ end = struct let open Memo.O in find_internal db name >>= function | Found lib -> - Resolve.Memo.of_result (check_private_deps lib ~loc ~private_deps) + Resolve.Memo.of_result (Private_deps.check private_deps ~loc ~lib) | Not_found -> Error.not_found ~loc ~name | Invalid why -> Resolve.Memo.of_result (Error why) | Hidden h -> Hidden.error h ~loc ~name @@ -1283,8 +1298,20 @@ 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* lib = resolve_dep db (loc, name) ~private_deps:Allow_all in + let open Resolve.Memo.O in + let* lib = + resolve_dep db_host (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) @@ -1294,12 +1321,25 @@ end = struct in let runtime_deps = let* pps = pps in - Resolve.List.concat_map pps ~f:(fun pp -> - let open Resolve.O in - let* ppx_runtime_deps = pp.ppx_runtime_deps 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.map ppx_runtime_deps ~f:(fun dep -> - check_private_deps ~loc ~private_deps dep |> Resolve.of_result)) - |> Memo.return + Private_deps.check private_deps ~lib:dep ~loc + |> Resolve.of_result) + |> Memo.return) in { runtime_deps; pps } @@ -1625,7 +1665,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 = register_work todo lib.ppx_runtime_deps in + let* todo = ppx_runtime_deps lib >>= register_work todo in let* todo = register_work todo lib.requires in work todo acc in @@ -1725,12 +1765,47 @@ module DB = struct type t = db - let create ~parent ~resolve ~all ~lib_config () = - { parent; resolve; all = Memo.lazy_ all; lib_config } + 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_from_findlib findlib = + let create_from_findlib ~host findlib = let lib_config = Findlib.lib_config findlib in - create () ~parent:None ~lib_config + create () ~parent:None ~host ~lib_config ~resolve:(fun name -> let open Memo.O in Findlib.find findlib name >>| function @@ -1746,12 +1821,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) = + let installed (context : Context.t) ~host = let open Memo.O in let+ findlib = Findlib.create ~paths:context.findlib_paths ~lib_config:context.lib_config in - create_from_findlib findlib + create_from_findlib ~host findlib let find t name = let open Memo.O in @@ -1921,7 +1996,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 = Memo.return lib.ppx_runtime_deps + and+ ppx_runtime_deps = ppx_runtime_deps lib 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 5cd3f440a077..87ea08d4fe2f 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 -> t Memo.t + val installed : Context.t -> host:t Memo.Lazy.t option -> t Memo.t module Resolve_result : sig type db := t @@ -124,6 +124,7 @@ 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 14c83616e079..1c422de63df2 100644 --- a/src/dune_rules/preprocessing.ml +++ b/src/dune_rules/preprocessing.ml @@ -715,7 +715,8 @@ 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 ~scope = + ~instrumentation_deps ~lib_name = + let scope = Expander.scope_host expander in 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 9e97eb77191f..da177e0e0c27 100644 --- a/src/dune_rules/preprocessing.mli +++ b/src/dune_rules/preprocessing.mli @@ -16,7 +16,6 @@ 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 c76ec5ca36db..ef740e2b69fa 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 stanzas = + let create_db_from_stanzas ~parent ~lib_config ~host 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) + Lib.DB.create () ~parent:(Some parent) ~host ~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 stanzas = + let public_libs t ~installed_libs ~lib_config ~host 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) ~resolve + Lib.DB.create ~parent:(Some installed_libs) ~host ~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 scopes_by_dir ~build_dir ~lib_config ~projects ~public_libs - ~public_theories stanzas coq_stanzas = + let rec scopes_by_dir ~host_context ~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,8 +267,20 @@ 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 ~lib_config + create_db_from_stanzas stanzas ~parent:public_libs ~host + ~lib_config in (project, db)) in @@ -288,14 +300,34 @@ module DB = struct let coq_db = coq_db_find dir in { project; db; coq_db; root }) - let create ~(context : Context.t) ~projects stanzas coq_stanzas = + and 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 = - let+ installed_libs = Lib.DB.installed context in - public_libs t ~lib_config ~installed_libs stanzas + 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) in let public_theories = let installed_theories = @@ -310,14 +342,14 @@ module DB = struct ~installed_theories coq_stanzas) in let+ by_dir = - scopes_by_dir ~build_dir ~lib_config ~projects ~public_libs + scopes_by_dir ~host_context ~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) - let create_from_stanzas ~projects ~(context : Context.t) stanzas = + and 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) -> @@ -339,22 +371,23 @@ module DB = struct in create ~projects ~context stanzas coq_stanzas - 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 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 create_from_stanzas (context : Context.t) = - let* all = Memo.Lazy.force all in + and create_from_stanzas (context : Context.t) = + let* all = Memo.Lazy.force (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 5659027ade03..d9bb2576874d 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 ~scope ~lib_name:None + Preprocessing.make sctx ~dir ~expander ~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 3ce0f1f6b319..3102db8c54f6 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 ~scope ~lib_name:None + Preprocessing.make sctx ~dir ~expander ~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 05cf21797f8f..1ecee22e5fc2 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,12 +1,16 @@ -# 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] +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 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 new file mode 100644 index 000000000000..971bc0372b78 --- /dev/null +++ b/test/blackbox-tests/test-cases/custom-cross-compilation/ppx-runtime-libraries.t @@ -0,0 +1,60 @@ +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 d0796bcfd73a..3c57cb66e89f 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,7 +8,8 @@ Handling ppx_runtime_libraries dependencies correctly $ chmod +x sdune ---------------------------------------------------------------------------------- -* Incorrect cycle detection due to ppx_runtime_libraries (TODO: fix this bug!) +ppx_runtime_libraries detection is delayed until they're used so this doesn't +cause a dependency cycle $ cat >dune-project < (lang dune 2.0) @@ -59,12 +60,7 @@ Handling ppx_runtime_libraries dependencies correctly > EOF $ ./sdune exec bin/main.exe - 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] + Should print 3: 3 ---------------------------------------------------------------------------------- * Ppx rewriters (and their ppx_runtime_libraries information) are collected recursively