From 5fc72f23e904c68dacb2c1f2f026ebdca24316dc Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 6 Apr 2023 20:08:07 -0600 Subject: [PATCH] feature: introduce public_headers This field works like install_c_headers except it allows full file names and allows to customize the destination paths Signed-off-by: Rudi Grinberg --- CHANGES.md | 4 ++ doc/stanzas/library.rst | 12 ++++- src/dune_rules/dep_conf.ml | 27 +++++++--- src/dune_rules/dep_conf.mli | 2 + src/dune_rules/dep_conf_eval.ml | 2 + src/dune_rules/dune_file.ml | 23 ++++++--- src/dune_rules/dune_file.mli | 1 + src/dune_rules/dune_package.ml | 27 ++++++---- src/dune_rules/findlib/findlib.ml | 7 +-- src/dune_rules/foreign_rules.ml | 2 +- src/dune_rules/install_rules.ml | 50 ++++++++----------- src/dune_rules/lib.ml | 5 +- src/dune_rules/lib.mli | 1 + src/dune_rules/lib_file_deps.ml | 32 ++++++++++++ src/dune_rules/lib_file_deps.mli | 13 +++++ src/dune_rules/lib_flags.ml | 32 +++++++++++- src/dune_rules/lib_flags.mli | 2 +- src/dune_rules/lib_info.ml | 35 ++++++++----- src/dune_rules/lib_info.mli | 10 ++-- src/dune_rules/melange/melange_rules.ml | 42 ++-------------- src/dune_rules/melange/melange_rules.mli | 13 ----- .../test-cases/foreign-stubs/public-headers.t | 47 +++++++++++++++++ 22 files changed, 263 insertions(+), 126 deletions(-) create mode 100644 test/blackbox-tests/test-cases/foreign-stubs/public-headers.t diff --git a/CHANGES.md b/CHANGES.md index 9b4e63ffa79..dccc28d1977 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,10 @@ Unreleased ---------- +- Introduce a `public_headers` field on libraries. This field is like + `install_c_headers`, but it allows to choose the extension and choose the + paths for the installed headers. (#7512, @rgrinberg) + - Load the host context `findlib.conf` when cross-compiling (#7428, fixes #1701, @rgrinberg, @anmonteiro) diff --git a/doc/stanzas/library.rst b/doc/stanzas/library.rst index 05e54d9fa35..5685d49e43d 100644 --- a/doc/stanzas/library.rst +++ b/doc/stanzas/library.rst @@ -102,7 +102,17 @@ order to declare a multi-directory library, you need to use the - ``(install_c_headers ())`` - if your library has public C header files that must be installed, you must list them in this field, without the ``.h`` - extension. + extension. You should favor the ``public_headers`` field starting from 3.8. + +- ``(public_headers ())`` - if your library has public C header files + that must be installed, you must list them in this field. This field accepts + globs in the form of ``(glob_files_rec )`` and ``(glob_files )`` + fields to specify multiple files. + + The advantage of this field over ``install_c_headers`` is that it preserves + the directory structures of the headers relative to the library stanza. + Additionally, it allows to specify the extensions of the header files, which + allows alternative extensions such as ``.hh`` or ``.hpp``. - ``(modes )`` is for modes which should be built by default. The most common use for this feature is to disable native compilation when writing diff --git a/src/dune_rules/dep_conf.ml b/src/dune_rules/dep_conf.ml index 547521f366f..59f6a518526 100644 --- a/src/dune_rules/dep_conf.ml +++ b/src/dune_rules/dep_conf.ml @@ -47,13 +47,21 @@ let decode_sandbox_config = in Sandbox_config.Partial.merge ~loc x -let decode = +let decode files = + let files_only = + match files with + | `Allow -> return () + | `Forbid -> + let* loc = loc in + User_error.raise ~loc + [ Pp.text "only files are allowed in this position" ] + in let decode = let sw = String_with_vars.decode in sum ~force_parens:true [ ("file", sw >>| fun x -> File x) - ; ("alias", sw >>| fun x -> Alias x) - ; ("alias_rec", sw >>| fun x -> Alias_rec x) + ; ("alias", files_only >>> sw >>| fun x -> Alias x) + ; ("alias_rec", files_only >>> sw >>| fun x -> Alias_rec x) ; ( "glob_files" , sw >>| fun glob -> Glob_files { Glob_files.glob; recursive = false } ) @@ -61,8 +69,8 @@ let decode = , let+ () = Dune_lang.Syntax.since Stanza.syntax (3, 0) and+ glob = sw in Glob_files { Glob_files.glob; recursive = true } ) - ; ("package", sw >>| fun x -> Package x) - ; ("universe", return Universe) + ; ("package", files_only >>> sw >>| fun x -> Package x) + ; ("universe", files_only >>> return Universe) ; ( "files_recursively_in" , let+ () = Dune_lang.Syntax.renamed_in Stanza.syntax (1, 0) ~to_:"source_tree" @@ -72,8 +80,9 @@ let decode = , let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 0) and+ x = sw in Source_tree x ) - ; ("env_var", sw >>| fun x -> Env_var x) - ; ("sandbox", decode_sandbox_config >>| fun x -> Sandbox_config x) + ; ("env_var", files_only >>> sw >>| fun x -> Env_var x) + ; ( "sandbox" + , files_only >>> decode_sandbox_config >>| fun x -> Sandbox_config x ) ; ( "include" , let+ () = Dune_lang.Syntax.since Stanza.syntax (3, 1) and+ filename = filename in @@ -84,6 +93,10 @@ let decode = <|> let+ x = String_with_vars.decode in File x +let decode_no_files = decode `Forbid + +let decode = decode `Allow + open Dune_lang let encode = function diff --git a/src/dune_rules/dep_conf.mli b/src/dune_rules/dep_conf.mli index 9ab78289d1f..2e0e577ea98 100644 --- a/src/dune_rules/dep_conf.mli +++ b/src/dune_rules/dep_conf.mli @@ -34,4 +34,6 @@ val remove_locs : t -> t include Dune_lang.Conv.S with type t := t +val decode_no_files : t Dune_lang.Decoder.t + val to_dyn : t Dyn.builder diff --git a/src/dune_rules/dep_conf_eval.ml b/src/dune_rules/dep_conf_eval.ml index 2b96f16b33b..ced29469a8f 100644 --- a/src/dune_rules/dep_conf_eval.ml +++ b/src/dune_rules/dep_conf_eval.ml @@ -85,6 +85,8 @@ let add_sandbox_config acc (dep : Dep_conf.t) = let rec dep expander = function | Include s -> + (* TODO this is wrong. we shouldn't allow bindings here if we are in an + unnamed expansion *) let deps = expand_include ~expander s in Other (let* deps = deps in diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml index 65c3f0f96d1..82c966d6ed6 100644 --- a/src/dune_rules/dune_file.ml +++ b/src/dune_rules/dune_file.ml @@ -563,6 +563,7 @@ module Library = struct ; visibility : visibility ; synopsis : string option ; install_c_headers : (Loc.t * string) list + ; public_headers : Loc.t * Dep_conf.t list ; ppx_runtime_libraries : (Loc.t * Lib_name.t) list ; modes : Mode_conf.Lib.Set.t ; kind : Lib_kind.t @@ -600,6 +601,11 @@ module Library = struct and+ synopsis = field_o "synopsis" string and+ install_c_headers = field "install_c_headers" (repeat (located string)) ~default:[] + and+ public_headers = + field "public_headers" + (Dune_lang.Syntax.since Stanza.syntax (3, 8) + >>> located (repeat Dep_conf.decode_no_files)) + ~default:(stanza_loc, []) and+ ppx_runtime_libraries = field "ppx_runtime_libraries" (repeat (located Lib_name.decode)) @@ -735,6 +741,7 @@ module Library = struct ; visibility ; synopsis ; install_c_headers + ; public_headers ; ppx_runtime_libraries ; modes ; kind @@ -987,15 +994,19 @@ module Library = struct let entry_modules = Lib_info.Source.Local in let melange_runtime_deps = let loc, runtime_deps = conf.melange_runtime_deps in - Lib_info.Runtime_deps.Local (loc, runtime_deps) + Lib_info.File_deps.Local (loc, runtime_deps) + in + let public_headers = + let loc, public_headers = conf.public_headers in + Lib_info.File_deps.Local (loc, public_headers) in Lib_info.create ~loc ~path_kind:Local ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems - ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps - ~foreign_archives ~native_archives ~foreign_dll_files ~jsoo_runtime - ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~entry_modules - ~implements ~default_implementation ~modes ~modules:Local ~wrapped - ~special_builtin_support ~exit_module ~instrumentation_backend + ~requires ~foreign_objects ~public_headers ~plugins ~archives + ~ppx_runtime_deps ~foreign_archives ~native_archives ~foreign_dll_files + ~jsoo_runtime ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ + ~entry_modules ~implements ~default_implementation ~modes ~modules:Local + ~wrapped ~special_builtin_support ~exit_module ~instrumentation_backend ~melange_runtime_deps end diff --git a/src/dune_rules/dune_file.mli b/src/dune_rules/dune_file.mli index 83a1d97a135..13468817ac6 100644 --- a/src/dune_rules/dune_file.mli +++ b/src/dune_rules/dune_file.mli @@ -148,6 +148,7 @@ module Library : sig ; visibility : visibility ; synopsis : string option ; install_c_headers : (Loc.t * string) list + ; public_headers : Loc.t * Dep_conf.t list ; ppx_runtime_libraries : (Loc.t * Lib_name.t) list ; modes : Mode_conf.Lib.Set.t ; kind : Lib_kind.t diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index 1f0e96f6dd1..29636c5f2f5 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -43,11 +43,21 @@ module Lib = struct let modes = Lib_info.modes info in let synopsis = Lib_info.synopsis info in let obj_dir = Lib_info.obj_dir info in + let additional_paths (paths : _ Lib_info.File_deps.t) = + match paths with + | Local _ -> assert false + | External paths -> + let lib_dir = Obj_dir.dir obj_dir in + List.map paths ~f:(fun p -> + Path.as_in_build_dir_exn p |> Path.Build.drop_build_context_exn + |> Path.append_source lib_dir) + in let orig_src_dir = Lib_info.orig_src_dir info in let implements = Lib_info.implements info in let ppx_runtime_deps = Lib_info.ppx_runtime_deps info in let default_implementation = Lib_info.default_implementation info in let special_builtin_support = Lib_info.special_builtin_support info in + let public_headers = additional_paths (Lib_info.public_headers info) in let archives = Lib_info.archives info in let sub_systems = Lib_info.sub_systems info in let plugins = Lib_info.plugins info in @@ -63,13 +73,7 @@ module Lib = struct | Local -> None in let melange_runtime_deps = - match Lib_info.melange_runtime_deps info with - | Local _ -> assert false - | External paths -> - let lib_dir = Obj_dir.dir obj_dir in - List.map paths ~f:(fun p -> - Path.as_in_build_dir_exn p |> Path.Build.drop_build_context_exn - |> Path.append_source lib_dir) + additional_paths (Lib_info.melange_runtime_deps info) in let jsoo_runtime = Lib_info.jsoo_runtime info in let virtual_ = Option.is_some (Lib_info.virtual_ info) in @@ -97,6 +101,7 @@ module Lib = struct ; mode_paths "archives" archives ; mode_paths "plugins" plugins ; paths "foreign_objects" foreign_objects + ; paths "public_headers" public_headers ; field_i "foreign_archives" (Mode.Map.encode path) (Lib_info.foreign_archives info) ; paths "foreign_dll_files" foreign_dll_files @@ -155,6 +160,7 @@ module Lib = struct and+ archives = mode_paths "archives" and+ plugins = mode_paths "plugins" and+ foreign_objects = paths "foreign_objects" + and+ public_headers = paths "public_headers" and+ foreign_archives = if lang.version >= (3, 5) then let+ field_o = field_o "foreign_archives" (Mode.Map.decode path) in @@ -199,6 +205,7 @@ module Lib = struct let version = None in let main_module_name = Lib_info.Inherited.This main_module_name in let foreign_objects = Lib_info.Source.External foreign_objects in + let public_headers = Lib_info.File_deps.External public_headers in let preprocess = Preprocess.Per_module.no_preprocessing () in let virtual_deps = [] in let dune_version = None in @@ -211,12 +218,12 @@ module Lib = struct let entry_modules = Lib_info.Source.External (Ok entry_modules) in let modules = Lib_info.Source.External (Some modules) in let melange_runtime_deps = - Lib_info.Runtime_deps.External melange_runtime_deps + Lib_info.File_deps.External melange_runtime_deps in Lib_info.create ~path_kind:External ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name - ~sub_systems ~requires ~foreign_objects ~plugins ~archives - ~ppx_runtime_deps ~foreign_archives + ~sub_systems ~requires ~foreign_objects ~public_headers ~plugins + ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives:(Files native_archives) ~foreign_dll_files ~jsoo_runtime ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~entry_modules ~implements ~default_implementation ~modes diff --git a/src/dune_rules/findlib/findlib.ml b/src/dune_rules/findlib/findlib.ml index 904b7132be8..7d39e4838c4 100644 --- a/src/dune_rules/findlib/findlib.ml +++ b/src/dune_rules/findlib/findlib.ml @@ -487,9 +487,10 @@ end = struct | _ -> None in let foreign_objects = Lib_info.Source.External [] in + let public_headers = Lib_info.File_deps.External [] in let plugins = plugins t in let jsoo_runtime = jsoo_runtime t in - let melange_runtime_deps = Lib_info.Runtime_deps.External [] in + let melange_runtime_deps = Lib_info.File_deps.External [] in let preprocess = Preprocess.Per_module.no_preprocessing () in let virtual_ = None in let default_implementation = None in @@ -572,8 +573,8 @@ end = struct let modules = Lib_info.Source.External None in Lib_info.create ~path_kind:External ~loc ~name:t.name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name - ~sub_systems ~requires ~foreign_objects ~plugins ~archives - ~ppx_runtime_deps ~foreign_archives + ~sub_systems ~requires ~foreign_objects ~public_headers ~plugins + ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives:(Files native_archives) ~foreign_dll_files:[] ~jsoo_runtime ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~implements ~default_implementation ~modes ~modules ~wrapped diff --git a/src/dune_rules/foreign_rules.ml b/src/dune_rules/foreign_rules.ml index c2ef1e829f4..e2f33c67a4b 100644 --- a/src/dune_rules/foreign_rules.ml +++ b/src/dune_rules/foreign_rules.ml @@ -225,7 +225,7 @@ let build_o_files ~sctx ~foreign_sources ~(dir : Path.Build.t) ~expander (let open Resolve.O in let+ libs = requires in Command.Args.S - [ Lib_flags.L.c_include_flags libs + [ Lib_flags.L.c_include_flags libs sctx ; Hidden_deps (Lib_file_deps.deps libs ~groups:[ Header ]) ]) ] diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index c1e9e02f4ec..aff76660896 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -173,14 +173,13 @@ end = struct in make_entry ?sub_dir Lib source ?dst)) in - let* melange_runtime_entries = - let loc, melange_runtime_deps = lib.melange_runtime_deps in - let+ melange_runtime_deps = + let additional_deps (loc, deps) = + let+ deps = let* expander = Super_context.expander sctx ~dir:lib_src_dir in - Melange_rules.Runtime_deps.eval ~expander ~loc - ~paths:(Disallow_external lib_name) melange_runtime_deps + Lib_file_deps.eval deps ~expander ~loc + ~paths:(Disallow_external lib_name) in - Path.Set.to_list_map melange_runtime_deps ~f:(fun path -> + Path.Set.to_list_map deps ~f:(fun path -> let path = Path.as_in_build_dir_exn path in let sub_dir = let src_dir = Path.Build.parent_exn path in @@ -193,6 +192,8 @@ end = struct in make_entry ?sub_dir Lib path) in + let* melange_runtime_entries = additional_deps lib.melange_runtime_deps + and+ public_headers = additional_deps lib.public_headers in let { Lib_config.has_native; ext_obj; _ } = lib_config in let { Lib_mode.Map.ocaml = { Mode.Dict.byte; native } as ocaml; melange } = Dune_file.Mode_conf.Lib.Set.eval lib.modes ~has_native @@ -266,12 +267,12 @@ end = struct let dll_files = dll_files ~modes:ocaml ~dynlink:lib.dynlink ~ctx info in (lib_files, dll_files) in - let+ execs = lib_ppxs ctx ~scope ~lib in let install_c_headers = List.rev_map lib.install_c_headers ~f:(fun (loc, base) -> Path.Build.relative dir (base ^ Foreign_language.header_extension) |> make_entry ~loc Lib) in + let+ execs = lib_ppxs ctx ~scope ~lib in List.concat [ sources ; melange_runtime_entries @@ -283,6 +284,7 @@ end = struct let entry = Install.Entry.make ~kind:`File Stublibs a in Install.Entry.Sourced.create ~loc entry) ; install_c_headers + ; public_headers ] let keep_if expander ~scope stanza = @@ -563,17 +565,19 @@ end = struct { loc; old_public_name; new_public_name } )) | Library lib -> let info = Lib.Local.info lib in - let* dir_contents = - let dir = Lib_info.src_dir info in - Dir_contents.get sctx ~dir - in + let dir = Lib_info.src_dir info in + let* dir_contents = Dir_contents.get sctx ~dir in let obj_dir = Lib.Local.obj_dir lib in - let lib_src_dir = - let info = Lib.Local.info lib in - Lib_info.src_dir info - in let lib = Lib.Local.to_lib lib in let name = Lib.name lib in + let* expander = Super_context.expander sctx ~dir in + let file_deps (deps : _ Lib_info.File_deps.t) = + match deps with + | External _paths -> assert false + | Local (loc, dep_conf) -> + Lib_file_deps.eval ~expander ~loc ~paths:Allow_all dep_conf + >>| Path.Set.to_list + in let* foreign_objects = (* We are writing the list of .o files to dune-package, but we actually only install them for virtual libraries. See @@ -590,22 +594,12 @@ end = struct Dir_contents.ocaml dir_contents >>| Ml_sources.modules ~for_:(Library name) and* melange_runtime_deps = - match Lib_info.melange_runtime_deps info with - | External _paths -> assert false - | Local (loc, dep_conf) -> - let+ melange_runtime_deps = - let* expander = - Super_context.expander sctx ~dir:lib_src_dir - in - Melange_rules.Runtime_deps.eval ~expander ~loc - ~paths:Allow_all dep_conf - in - Path.Set.to_list melange_runtime_deps - in + file_deps (Lib_info.melange_runtime_deps info) + and* public_headers = file_deps (Lib_info.public_headers info) in let+ sub_systems = Lib.to_dune_lib lib ~dir:(Path.build (lib_root lib)) - ~modules ~foreign_objects ~melange_runtime_deps + ~modules ~foreign_objects ~melange_runtime_deps ~public_headers >>= Resolve.read_memo in Some (name, Dune_package.Entry.Library sub_systems)) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index cabeaf93b58..97fa3e2efc1 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1956,7 +1956,8 @@ module DB = struct end let to_dune_lib ({ info; _ } as lib) ~modules ~foreign_objects - ~melange_runtime_deps ~dir : Dune_package.Lib.t Resolve.Memo.t = + ~melange_runtime_deps ~public_headers ~dir : + Dune_package.Lib.t Resolve.Memo.t = let loc = Lib_info.loc info in let mangled_name lib = match Lib_info.status lib.info with @@ -2009,7 +2010,7 @@ let to_dune_lib ({ info; _ } as lib) ~modules ~foreign_objects let info = Lib_info.for_dune_package info ~name ~ppx_runtime_deps ~requires ~foreign_objects ~obj_dir ~implements ~default_implementation ~sub_systems - ~modules ~melange_runtime_deps + ~modules ~melange_runtime_deps ~public_headers in Dune_package.Lib.of_dune_lib ~info ~main_module_name diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 8561611cd2d..467a6eb2f51 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -227,6 +227,7 @@ val to_dune_lib : -> modules:Modules.t -> foreign_objects:Path.t list -> melange_runtime_deps:Path.t list + -> public_headers:Path.t list -> dir:Path.t -> Dune_package.Lib.t Resolve.Memo.t diff --git a/src/dune_rules/lib_file_deps.ml b/src/dune_rules/lib_file_deps.ml index 32a8942e08a..3df01138fbb 100644 --- a/src/dune_rules/lib_file_deps.ml +++ b/src/dune_rules/lib_file_deps.ml @@ -57,3 +57,35 @@ let deps_with_exts = Dep.Set.union_map ~f:(fun (lib, groups) -> deps_of_lib lib ~groups) let deps libs ~groups = Dep.Set.union_map libs ~f:(deps_of_lib ~groups) + +type path_specification = + | Allow_all + | Disallow_external of Lib_name.t + +let raise_disallowed_external_path ~loc lib_name path = + User_error.raise ~loc + [ Pp.textf + "Public library %s depends on external path `%s'. This is not allowed." + (Lib_name.to_string lib_name) + (Path.to_string path) + ] + ~hints: + [ Pp.textf + "Move the external dependency to the workspace and use a relative \ + path." + ] + +let eval ~loc ~expander ~paths:path_spec (deps : Dep_conf.t list) = + let runtime_deps, sandbox = Dep_conf_eval.unnamed_get_paths ~expander deps in + Option.iter sandbox ~f:(fun _ -> + User_error.raise ~loc [ Pp.text "sandbox settings are not allowed" ]); + let open Memo.O in + let+ paths, _ = Action_builder.run runtime_deps Lazy in + (match path_spec with + | Allow_all -> () + | Disallow_external lib_name -> + Path.Set.iter paths ~f:(fun path -> + match Path.as_external path with + | None -> () + | Some _ -> raise_disallowed_external_path ~loc lib_name path)); + paths diff --git a/src/dune_rules/lib_file_deps.mli b/src/dune_rules/lib_file_deps.mli index edfedac131e..6a9ca884521 100644 --- a/src/dune_rules/lib_file_deps.mli +++ b/src/dune_rules/lib_file_deps.mli @@ -16,3 +16,16 @@ end val deps : Lib.t list -> groups:Group.t list -> Dep.Set.t val deps_with_exts : (Lib.t * Group.t list) list -> Dep.Set.t + +type path_specification = + | Allow_all + | Disallow_external of Lib_name.t + +val raise_disallowed_external_path : loc:Loc.t -> Lib_name.t -> Path.t -> 'a + +val eval : + loc:Loc.t + -> expander:Expander.t + -> paths:path_specification + -> Dep_conf.t list + -> Path.Set.t Memo.t diff --git a/src/dune_rules/lib_flags.ml b/src/dune_rules/lib_flags.ml index fa8e9ad27b4..71bf6155183 100644 --- a/src/dune_rules/lib_flags.ml +++ b/src/dune_rules/lib_flags.ml @@ -152,7 +152,37 @@ module L = struct in remove_stdlib dirs ts - let c_include_flags ts = to_iflags (c_include_paths ts) + let c_include_flags ts sctx = + let open Memo.O in + let local, external_ = + List.fold_left ts ~init:([], Dep.Set.empty) + ~f:(fun (local, external_) lib -> + let info = Lib.info lib in + match Lib_info.public_headers info with + | External paths -> + (local, Dep.Set.union external_ (Dep.Set.of_files paths)) + | Local (_loc, public_headers) -> + let dir = Path.as_in_build_dir_exn @@ Lib_info.src_dir info in + let headers = + let+ expander = Super_context.expander sctx ~dir in + let deps, sandbox = + Dep_conf_eval.unnamed ~expander public_headers + in + assert ( + Sandbox_config.equal sandbox + Sandbox_config.no_special_requirements); + deps + in + (headers :: local, external_)) + in + let local = + let open Action_builder.O in + let* bindings = Action_builder.of_memo @@ Memo.all_concurrently local in + let+ () = Action_builder.all_unit bindings in + Command.Args.empty + in + Command.Args.S + [ Dyn local; Hidden_deps external_; to_iflags (c_include_paths ts) ] let toplevel_include_paths ts = let with_dlls = diff --git a/src/dune_rules/lib_flags.mli b/src/dune_rules/lib_flags.mli index 9b1657973e1..cb80a5d2f88 100644 --- a/src/dune_rules/lib_flags.mli +++ b/src/dune_rules/lib_flags.mli @@ -29,7 +29,7 @@ module L : sig val include_flags : ?project:Dune_project.t -> t -> Lib_mode.t -> _ Command.Args.t - val c_include_flags : t -> _ Command.Args.t + val c_include_flags : t -> Super_context.t -> _ Command.Args.t val toplevel_include_paths : t -> Path.Set.t end diff --git a/src/dune_rules/lib_info.ml b/src/dune_rules/lib_info.ml index d62b132d2f5..7f616bd1901 100644 --- a/src/dune_rules/lib_info.ml +++ b/src/dune_rules/lib_info.ml @@ -281,7 +281,7 @@ let dyn_of_native_archives path = | Needs_module_info f -> variant "Needs_module_info" [ path f ] | Files files -> variant "Files" [ (list path) files ] -module Runtime_deps = struct +module File_deps = struct type 'a t = | Local of Loc.t * Dep_conf.t list | External of 'a list @@ -325,6 +325,7 @@ type 'path t = ; archives : 'path list Mode.Dict.t ; plugins : 'path list Mode.Dict.t ; foreign_objects : 'path list Source.t + ; public_headers : 'path File_deps.t ; foreign_archives : 'path Mode.Map.Multi.t ; native_archives : 'path native_archives ; foreign_dll_files : 'path list @@ -348,7 +349,7 @@ type 'path t = ; exit_module : Module_name.t option ; instrumentation_backend : (Loc.t * Lib_name.t) option ; path_kind : 'path path - ; melange_runtime_deps : 'path Runtime_deps.t + ; melange_runtime_deps : 'path File_deps.t } let equal (type a) (t : a t) @@ -364,6 +365,7 @@ let equal (type a) (t : a t) ; archives ; plugins ; foreign_objects + ; public_headers ; foreign_archives ; native_archives ; foreign_dll_files @@ -405,6 +407,7 @@ let equal (type a) (t : a t) && Mode.Dict.equal (List.equal path_equal) archives t.archives && Mode.Dict.equal (List.equal path_equal) plugins t.plugins && Source.equal (List.equal path_equal) foreign_objects t.foreign_objects + && File_deps.equal path_equal public_headers t.public_headers && Mode.Map.Multi.equal ~equal:path_equal foreign_archives t.foreign_archives && equal_native_archives path_equal native_archives t.native_archives && List.equal path_equal foreign_dll_files t.foreign_dll_files @@ -442,7 +445,7 @@ let equal (type a) (t : a t) && Option.equal (Tuple.T2.equal Loc.equal Lib_name.equal) instrumentation_backend t.instrumentation_backend - && Runtime_deps.equal path_equal melange_runtime_deps t.melange_runtime_deps + && File_deps.equal path_equal melange_runtime_deps t.melange_runtime_deps && Poly.equal path_kind t.path_kind let name t = t.name @@ -475,6 +478,8 @@ let foreign_dll_files t = t.foreign_dll_files let foreign_objects t = t.foreign_objects +let public_headers t = t.public_headers + let exit_module t = t.exit_module let instrumentation_backend t = t.instrumentation_backend @@ -525,7 +530,7 @@ let eval_native_archives_exn (type path) (t : path t) ~modules = let for_dune_package t ~name ~ppx_runtime_deps ~requires ~foreign_objects ~obj_dir ~implements ~default_implementation ~sub_systems - ~melange_runtime_deps ~modules = + ~melange_runtime_deps ~public_headers ~modules = let foreign_objects = Source.External foreign_objects in let orig_src_dir = match !Clflags.store_orig_src_dir with @@ -544,7 +549,8 @@ let for_dune_package t ~name ~ppx_runtime_deps ~requires ~foreign_objects Files (eval_native_archives_exn t ~modules:(Some modules)) in let modules = Source.External (Some modules) in - let melange_runtime_deps = Runtime_deps.External melange_runtime_deps in + let melange_runtime_deps = File_deps.External melange_runtime_deps in + let public_headers = File_deps.External public_headers in { t with ppx_runtime_deps ; name @@ -558,6 +564,7 @@ let for_dune_package t ~name ~ppx_runtime_deps ~requires ~foreign_objects ; native_archives ; modules ; melange_runtime_deps + ; public_headers } let user_written_deps t = @@ -566,11 +573,11 @@ let user_written_deps t = let create ~loc ~path_kind ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects - ~plugins ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives - ~foreign_dll_files ~jsoo_runtime ~preprocess ~enabled ~virtual_deps - ~dune_version ~virtual_ ~entry_modules ~implements ~default_implementation - ~modes ~modules ~wrapped ~special_builtin_support ~exit_module - ~instrumentation_backend ~melange_runtime_deps = + ~public_headers ~plugins ~archives ~ppx_runtime_deps ~foreign_archives + ~native_archives ~foreign_dll_files ~jsoo_runtime ~preprocess ~enabled + ~virtual_deps ~dune_version ~virtual_ ~entry_modules ~implements + ~default_implementation ~modes ~modules ~wrapped ~special_builtin_support + ~exit_module ~instrumentation_backend ~melange_runtime_deps = { loc ; name ; kind @@ -583,6 +590,7 @@ let create ~loc ~path_kind ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ; requires ; main_module_name ; foreign_objects + ; public_headers ; plugins ; archives ; ppx_runtime_deps @@ -629,12 +637,13 @@ let map t ~path_kind ~f_path ~f_obj_dir ~f_melange_deps = ; archives = mode_list t.archives ; plugins = mode_list t.plugins ; foreign_objects = Source.map ~f:(List.map ~f) t.foreign_objects + ; public_headers = File_deps.map ~f t.public_headers ; foreign_archives = Mode.Map.Multi.map t.foreign_archives ~f ; foreign_dll_files = List.map ~f t.foreign_dll_files ; native_archives ; jsoo_runtime = List.map ~f t.jsoo_runtime ; melange_runtime_deps = - Runtime_deps.map ~f:f_melange_deps t.melange_runtime_deps + File_deps.map ~f:f_melange_deps t.melange_runtime_deps ; path_kind } @@ -663,6 +672,7 @@ let to_dyn path ; requires ; main_module_name ; foreign_objects + ; public_headers ; plugins ; archives ; ppx_runtime_deps @@ -702,6 +712,7 @@ let to_dyn path ; ("archives", Mode.Dict.to_dyn (list path) archives) ; ("plugins", Mode.Dict.to_dyn (list path) plugins) ; ("foreign_objects", Source.to_dyn (list path) foreign_objects) + ; ("public_headers", File_deps.to_dyn path public_headers) ; ("foreign_archives", Mode.Map.Multi.to_dyn path foreign_archives) ; ("native_archives", dyn_of_native_archives path native_archives) ; ("foreign_dll_files", list path foreign_dll_files) @@ -727,7 +738,7 @@ let to_dyn path ; ("exit_module", option Module_name.to_dyn exit_module) ; ( "instrumentation_backend" , option (snd Lib_name.to_dyn) instrumentation_backend ) - ; ("melange_runtime_deps", Runtime_deps.to_dyn path melange_runtime_deps) + ; ("melange_runtime_deps", File_deps.to_dyn path melange_runtime_deps) ] let package t = diff --git a/src/dune_rules/lib_info.mli b/src/dune_rules/lib_info.mli index 29091ca5162..6dc2db6235a 100644 --- a/src/dune_rules/lib_info.mli +++ b/src/dune_rules/lib_info.mli @@ -28,7 +28,7 @@ module Source : sig | External of 'a end -module Runtime_deps : sig +module File_deps : sig type 'a t = | Local of Loc.t * Dep_conf.t list | External of 'a list @@ -120,6 +120,8 @@ val foreign_dll_files : 'path t -> 'path list val foreign_objects : 'path t -> 'path list Source.t +val public_headers : 'path t -> 'path File_deps.t + (** The library has a module that must be linked at the end. This is used for the [Std_exit] module of the stdlib. *) val exit_module : _ t -> Module_name.t option @@ -140,7 +142,7 @@ val synopsis : _ t -> string option val jsoo_runtime : 'path t -> 'path list -val melange_runtime_deps : 'path t -> 'path Runtime_deps.t +val melange_runtime_deps : 'path t -> 'path File_deps.t val obj_dir : 'path t -> 'path Obj_dir.t @@ -204,6 +206,7 @@ val for_dune_package : -> default_implementation:(Loc.t * Lib_name.t) option -> sub_systems:Sub_system_info.t Sub_system_name.Map.t -> melange_runtime_deps:Path.t list + -> public_headers:Path.t list -> modules:Modules.t -> Path.t t @@ -228,6 +231,7 @@ val create : -> sub_systems:Sub_system_info.t Sub_system_name.Map.t -> requires:Lib_dep.t list -> foreign_objects:'a list Source.t + -> public_headers:'a File_deps.t -> plugins:'a list Mode.Dict.t -> archives:'a list Mode.Dict.t -> ppx_runtime_deps:(Loc.t * Lib_name.t) list @@ -249,7 +253,7 @@ val create : -> special_builtin_support:Special_builtin_support.t option -> exit_module:Module_name.t option -> instrumentation_backend:(Loc.t * Lib_name.t) option - -> melange_runtime_deps:'a Runtime_deps.t + -> melange_runtime_deps:'a File_deps.t -> 'a t val package : _ t -> Package.Name.t option diff --git a/src/dune_rules/melange/melange_rules.ml b/src/dune_rules/melange/melange_rules.ml index 6e2bb0d3f65..79b95e42566 100644 --- a/src/dune_rules/melange/melange_rules.ml +++ b/src/dune_rules/melange/melange_rules.ml @@ -264,41 +264,6 @@ let setup_emit_cmj_rules ~sctx ~dir ~scope ~expander ~dir_contents Buildable_rules.with_lib_deps ctx compile_info ~dir ~f module Runtime_deps = struct - type path_specification = - | Allow_all - | Disallow_external of Lib_name.t - - let raise_disallowed_external_path ~loc lib_name path = - User_error.raise ~loc - [ Pp.textf - "Public library %s depends on external path `%s'. This is not \ - allowed." - (Lib_name.to_string lib_name) - (Path.to_string path) - ] - ~hints: - [ Pp.textf - "Move the external dependency to the workspace and use a relative \ - path." - ] - - let eval ~loc ~expander ~paths:path_spec (deps : Dep_conf.t list) = - let runtime_deps, sandbox = - Dep_conf_eval.unnamed_get_paths ~expander deps - in - Option.iter sandbox ~f:(fun _ -> - User_error.raise ~loc [ Pp.text "sandbox settings are not allowed" ]); - let open Memo.O in - let+ paths, _ = Action_builder.run runtime_deps Lazy in - (match path_spec with - | Allow_all -> () - | Disallow_external lib_name -> - Path.Set.iter paths ~f:(fun path -> - match Path.as_external path with - | None -> () - | Some _ -> raise_disallowed_external_path ~loc lib_name path)); - paths - let targets sctx ~dir ~output ~for_ (mel : Melange_stanzas.Emit.t) = let open Memo.O in let raise_external_dep_error src = @@ -312,14 +277,15 @@ module Runtime_deps = struct | Local (loc, _) -> loc | External _ -> assert false in - raise_disallowed_external_path ~loc (Lib_info.name lib_info) src + Lib_file_deps.raise_disallowed_external_path ~loc (Lib_info.name lib_info) + src in let+ deps = match for_ with | `Emit -> let* expander = Super_context.expander sctx ~dir in let loc, runtime_deps = mel.runtime_deps in - eval ~expander ~loc ~paths:Allow_all runtime_deps + Lib_file_deps.eval ~expander ~loc ~paths:Allow_all runtime_deps | `Library lib_info -> ( match Lib_info.melange_runtime_deps lib_info with | External paths -> Memo.return (Path.Set.of_list paths) @@ -329,7 +295,7 @@ module Runtime_deps = struct Lib_info.src_dir info in let* expander = Super_context.expander sctx ~dir in - eval ~expander ~loc ~paths:Allow_all dep_conf) + Lib_file_deps.eval ~expander ~loc ~paths:Allow_all dep_conf) in Path.Set.fold ~init:([], []) deps ~f:(fun src (copy, non_copy) -> match output with diff --git a/src/dune_rules/melange/melange_rules.mli b/src/dune_rules/melange/melange_rules.mli index 4374fe2e770..e2faf7f2054 100644 --- a/src/dune_rules/melange/melange_rules.mli +++ b/src/dune_rules/melange/melange_rules.mli @@ -16,16 +16,3 @@ val setup_emit_js_rules : -> sctx:Super_context.t -> Melange_stanzas.Emit.t -> unit Memo.t - -module Runtime_deps : sig - type path_specification = - | Allow_all - | Disallow_external of Lib_name.t - - val eval : - loc:Loc.t - -> expander:Expander.t - -> paths:path_specification - -> Dep_conf.t list - -> Path.Set.t Memo.t -end diff --git a/test/blackbox-tests/test-cases/foreign-stubs/public-headers.t b/test/blackbox-tests/test-cases/foreign-stubs/public-headers.t new file mode 100644 index 00000000000..218a1a40e6f --- /dev/null +++ b/test/blackbox-tests/test-cases/foreign-stubs/public-headers.t @@ -0,0 +1,47 @@ +Headers with the same filename cannot be installed together: + + $ cat >dune-project < (lang dune 3.8) + > (package (name mypkg)) + > EOF + + $ mkdir inc + + $ cat >dune < (library + > (public_name mypkg) + > (public_headers foo.h inc/foo.h)) + > EOF + + $ touch foo.h inc/foo.h + + $ dune build mypkg.install && cat _build/default/mypkg.install | grep ".h" + "_build/install/default/lib/mypkg/foo.h" + "_build/install/default/lib/mypkg/inc/foo.h" {"inc/foo.h"} + +Now we try to use the installed headers: + + $ dune install --prefix _install mypkg + $ export OCAMLPATH=$PWD/_install/lib:$OCAMLPATH + + $ mkdir subdir + $ cd subdir + + $ cat >dune-project < (lang dune 3.8) + > EOF + + $ cat >dune < (executable + > (name bar) + > (foreign_stubs + > (language c) + > (include_dirs (lib mypkg)) + > (names foo))) + > EOF + $ touch bar.ml + $ cat >foo.c < #include + > #include + > EOF + $ dune build bar.exe