diff --git a/CHANGES.md b/CHANGES.md index 0dbafeceb3d..a1813b46f0d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -89,6 +89,8 @@ Coq 8.16.0, Coq itself has some bugs preventing this to work yet. (#6167 , workarounds #5767, @ejgallego) +- Allow include statement in install stanza (#6139, fixes #256, @gridbugs) + 3.4.1 (26-07-2022) ------------------ diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 54d846420d7..f22c7923721 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -1415,6 +1415,37 @@ installed in. If the section above is documented as "with the executable bit set", they are installed with mode ``0o755`` (``rwxr-xr-x``); otherwise they are installed with mode ``0o644`` (``rw-r--r--``). +Including Files in the Install Stanza +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +You can include external files from the ``files`` and ``dirs`` fields of the +install stanza: + +.. code:: scheme + + (install + (files (include foo.sexp)) + (section share)) + +Here the file ``foo.sexp`` must contain a single S-expression list, whose +elements will be included in the list of files or directories to install. That +is, elements may be of the form: + +- ```` +- ``( as )`` +- ``(include )`` + +Included files may be generated by rules. Here is an example of a rule which +generates a file by listing all the files in a subdirectory ``resources``: + +.. code:: scheme + + (rule + (deps (source_tree resources)) + (action + (with-stdout-to foo.sexp + (system "echo '(' resources/* ')'")))) + Handling of the .exe Extension on Windows ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/src/dune_rules/artifacts_db.ml b/src/dune_rules/artifacts_db.ml index cc7fdd96bdb..5025adaf12f 100644 --- a/src/dune_rules/artifacts_db.ml +++ b/src/dune_rules/artifacts_db.ml @@ -13,7 +13,11 @@ let get_installed_binaries ~(context : Context.t) stanzas = Memo.List.map stanzas ~f:(fun (d : Dune_file.t) -> let dir = Path.Build.append_source context.build_dir d.dir in let binaries_from_install files = - Memo.List.map files ~f:(fun fb -> + let* unexpanded_file_bindings = + Dune_file.Install_conf.File_entry.expand_include_multi files + ~expand_str:(expand_str ~dir) ~dir + in + Memo.List.map unexpanded_file_bindings ~f:(fun fb -> let+ p = File_binding.Unexpanded.destination_relative_to_install_path fb ~section:Bin ~expand:(expand_str ~dir) diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml index 82757caacc9..a84700b9141 100644 --- a/src/dune_rules/dune_file.ml +++ b/src/dune_rules/dune_file.ml @@ -944,10 +944,37 @@ module Plugin = struct end module Install_conf = struct + module File_entry = struct + include + Recursive_include.Make + (File_binding.Unexpanded) + (struct + let include_keyword = "include" + + let include_allowed_in_versions = `Since (3, 5) + + let non_sexp_behaviour = `User_error + end) + + let expand_include_multi ts ~expand_str ~dir = + Memo.List.concat_map ts ~f:(expand_include ~expand_str ~dir) + + let of_file_binding = of_base + + let expand t ~expand_str ~dir = + let open Memo.O in + let* unexpanded = expand_include t ~expand_str ~dir in + Memo.List.map unexpanded + ~f:(File_binding.Unexpanded.expand ~dir ~f:expand_str) + + let expand_multi ts ~expand_str ~dir = + Memo.List.concat_map ts ~f:(expand ~expand_str ~dir) + end + type t = { section : Install.Section_with_site.t - ; files : File_binding.Unexpanded.t list - ; dirs : File_binding.Unexpanded.t list + ; files : File_entry.t list + ; dirs : File_entry.t list ; package : Package.t ; enabled_if : Blang.t } @@ -956,11 +983,11 @@ module Install_conf = struct fields (let+ loc = loc and+ section = field "section" Install.Section_with_site.decode - and+ files = field_o "files" File_binding.Unexpanded.L.decode + and+ files = field_o "files" (repeat File_entry.decode) and+ dirs = field_o "dirs" (Dune_lang.Syntax.since Stanza.syntax (3, 5) - >>> File_binding.Unexpanded.L.decode) + >>> repeat File_entry.decode) and+ package = Stanza_common.Pkg.field ~stanza:"install" and+ enabled_if = let allowed_vars = Enabled_if.common_vars ~since:(2, 6) in @@ -975,6 +1002,10 @@ module Install_conf = struct in { section; dirs; files; package; enabled_if }) + + let expand_files t = File_entry.expand_multi t.files + + let expand_dirs t = File_entry.expand_multi t.dirs end module Executables = struct @@ -1134,9 +1165,10 @@ module Executables = struct let files = List.map2 t.names public_names ~f:(fun (locn, name) (locp, pub) -> Option.map pub ~f:(fun pub -> - File_binding.Unexpanded.make - ~src:(locn, name ^ ext) - ~dst:(locp, pub))) + Install_conf.File_entry.of_file_binding + (File_binding.Unexpanded.make + ~src:(locn, name ^ ext) + ~dst:(locp, pub)))) |> List.filter_opt in { Install_conf.section = Section Bin diff --git a/src/dune_rules/dune_file.mli b/src/dune_rules/dune_file.mli index c073161135c..4a44f0a5639 100644 --- a/src/dune_rules/dune_file.mli +++ b/src/dune_rules/dune_file.mli @@ -204,13 +204,41 @@ module Plugin : sig end module Install_conf : sig + module File_entry : sig + type t + + val expand_include_multi : + t list + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> File_binding.Unexpanded.t list Memo.t + + val expand_multi : + t list + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> File_binding.Expanded.t list Memo.t + end + type t = { section : Install.Section_with_site.t - ; files : File_binding.Unexpanded.t list - ; dirs : File_binding.Unexpanded.t list + ; files : File_entry.t list + ; dirs : File_entry.t list ; package : Package.t ; enabled_if : Blang.t } + + val expand_files : + t + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> File_binding.Expanded.t list Memo.t + + val expand_dirs : + t + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> File_binding.Expanded.t list Memo.t end module Executables : sig diff --git a/src/dune_rules/file_binding.ml b/src/dune_rules/file_binding.ml index de0a20e852b..8badebb3dd0 100644 --- a/src/dune_rules/file_binding.ml +++ b/src/dune_rules/file_binding.ml @@ -63,44 +63,41 @@ module Unexpanded = struct in { src; dst } - module L = struct - let decode_file = - let open Dune_lang.Decoder in - let decode = - let+ is_atom = - peek_exn >>| function - | Atom _ -> true - | _ -> false - and+ s = String_with_vars.decode - and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in - if (not is_atom) && version < (1, 6) then - let what = - (if String_with_vars.has_pforms s then "variables" - else "quoted strings") - |> sprintf "Using %s here" - in - Dune_lang.Syntax.Error.since (String_with_vars.loc s) Stanza.syntax - (1, 6) ~what - else s - in - peek_exn >>= function - | Atom _ | Quoted_string _ | Template _ -> - decode >>| fun src -> { src; dst = None } - | List (_, [ _; Atom (_, A "as"); _ ]) -> - enter - (let* src = decode in - keyword "as" - >>> let* dst = decode in - return { src; dst = Some dst }) - | sexp -> - User_error.raise ~loc:(Dune_lang.Ast.loc sexp) - [ Pp.text - "invalid format, or ( as ) expected" - ] - + let decode = + let open Dune_lang.Decoder in let decode = - let open Dune_lang.Decoder in - repeat decode_file + let+ is_atom = + peek_exn >>| function + | Atom _ -> true + | _ -> false + and+ s = String_with_vars.decode + and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in + if (not is_atom) && version < (1, 6) then + let what = + (if String_with_vars.has_pforms s then "variables" + else "quoted strings") + |> sprintf "Using %s here" + in + Dune_lang.Syntax.Error.since (String_with_vars.loc s) Stanza.syntax + (1, 6) ~what + else s + in + peek_exn >>= function + | Atom _ | Quoted_string _ | Template _ -> + decode >>| fun src -> { src; dst = None } + | List (_, [ _; Atom (_, A "as"); _ ]) -> + enter + (let* src = decode in + keyword "as" + >>> let* dst = decode in + return { src; dst = Some dst }) + | sexp -> + User_error.raise ~loc:(Dune_lang.Ast.loc sexp) + [ Pp.text "Invalid format, or ( as ) expected" + ] + + module L = struct + let decode = Dune_lang.Decoder.repeat decode let strings_with_vars { src; dst } = src :: Option.to_list dst diff --git a/src/dune_rules/file_binding.mli b/src/dune_rules/file_binding.mli index 02996d9e493..8adc6f48b7a 100644 --- a/src/dune_rules/file_binding.mli +++ b/src/dune_rules/file_binding.mli @@ -19,6 +19,8 @@ module Unexpanded : sig val make : src:Loc.t * string -> dst:Loc.t * string -> t + val decode : t Dune_lang.Decoder.t + val expand : t -> dir:Path.Build.t diff --git a/src/dune_rules/foreign.ml b/src/dune_rules/foreign.ml index e6916676e1f..50cdb4a4b6e 100644 --- a/src/dune_rules/foreign.ml +++ b/src/dune_rules/foreign.ml @@ -88,14 +88,10 @@ module Archive = struct end module Stubs = struct - module Include_dir = struct + module Include_dir_without_include = struct type t = | Dir of String_with_vars.t | Lib of Loc.t * Lib_name.t - | Include of - { context : Univ_map.t - ; path : String_with_vars.t - } let decode : t Dune_lang.Decoder.t = let open Dune_lang.Decoder in @@ -103,19 +99,29 @@ module Stubs = struct let+ s = String_with_vars.decode in Dir s in - let parse_lib_or_include = + let parse_lib = sum [ ( "lib" , let+ loc, lib_name = located Lib_name.decode in Lib (loc, lib_name) ) - ; ( "include" - , let+ () = Syntax.since Stanza.syntax (3, 5) - and+ context = get_all - and+ path = String_with_vars.decode in - Include { context; path } ) ] in - parse_dir <|> parse_lib_or_include + parse_dir <|> parse_lib + end + + module Include_dir = struct + include + Recursive_include.Make + (Include_dir_without_include) + (struct + let include_keyword = "include" + + let include_allowed_in_versions = `Since (3, 5) + + let non_sexp_behaviour = `Parse_as_base_term + end) + + module Without_include = Include_dir_without_include end type t = diff --git a/src/dune_rules/foreign.mli b/src/dune_rules/foreign.mli index b205032d768..60a0f8a5f2a 100644 --- a/src/dune_rules/foreign.mli +++ b/src/dune_rules/foreign.mli @@ -77,15 +77,21 @@ module Stubs : sig (* Foreign sources can depend on a directly specified directory [Dir] or on a source directory of a library [Lib]. *) module Include_dir : sig - type t = - | Dir of String_with_vars.t - | Lib of Loc.t * Lib_name.t - | Include of - { context : Univ_map.t - ; path : String_with_vars.t - } + module Without_include : sig + type t = + | Dir of String_with_vars.t + | Lib of Loc.t * Lib_name.t + end + + type t val decode : t Dune_lang.Decoder.t + + val expand_include : + t + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> Without_include.t list Memo.t end type t = diff --git a/src/dune_rules/foreign_rules.ml b/src/dune_rules/foreign_rules.ml index 360b14b580a..f461d39c6df 100644 --- a/src/dune_rules/foreign_rules.ml +++ b/src/dune_rules/foreign_rules.ml @@ -8,61 +8,6 @@ module Source_tree_map_reduce = type t = Command.Args.without_targets Command.Args.t end)) -module Include_dir_expanded = struct - (* An [Include_dir.t] without the [Include] constructor *) - type t = - | Dir of String_with_vars.t - | Lib of Loc.t * Lib_name.t - - type include_t = - { context : Univ_map.t - ; path : String_with_vars.t - } - - let of_include_dir include_dir = - match (include_dir : Foreign.Stubs.Include_dir.t) with - | Dir d -> Right (Dir d) - | Lib (loc, lib_name) -> Right (Lib (loc, lib_name)) - | Include { context; path } -> Left { context; path } -end - -(* Recursively expand all the (include ...) terms in an [Include_dir.t], returning - a list of [Include_dir_expanded.t] *) -let expand_include_dir ~expander include_dir = - (* Parse a file at a specified path as a list of [Include_dir.t]s *) - let parse_include_dirs_file ~context path = - let open Action_builder.O in - let+ ast = Action_builder.read_sexp path in - let parse_single ast = - Dune_lang.Decoder.parse Foreign.Stubs.Include_dir.decode context ast - in - (* If the file contains a sexp list, parse each element of the list as an - [Include_dir.t]. - Otherwise parse the entire file's contents as a single [Include_dir.t]. - *) - match (ast : Dune_lang.Ast.t) with - | List (_loc, terms) -> List.map terms ~f:parse_single - | other -> [ parse_single other ] - in - let rec expand_include_dir ~seen include_dir = - match Include_dir_expanded.of_include_dir include_dir with - | Right include_dir_expanded -> - Action_builder.return [ include_dir_expanded ] - | Left { context; path } -> - expand_include_dir_include_statement ~seen ~context path - and expand_include_dir_include_statement ~seen ~context path_sw = - let open Action_builder.O in - let* path = Expander.expand_path expander path_sw in - if Path.Set.mem seen path then - User_error.raise - ~loc:(String_with_vars.loc path_sw) - [ Pp.textf "Include loop detected via: %s" (Path.to_string path) ]; - let seen = Path.Set.add seen path in - let* include_dirs = parse_include_dirs_file ~context path in - Action_builder.List.concat_map include_dirs ~f:(expand_include_dir ~seen) - in - expand_include_dir ~seen:Path.Set.empty include_dir - (* Compute command line flags for the [include_dirs] field of [Foreign.Stubs.t] and track all files in specified directories as [Hidden_deps] dependencies. *) @@ -77,7 +22,7 @@ let include_dir_flags ~expander ~dir (stubs : Foreign.Stubs.t) = Resolve.Memo.args (let open Resolve.Memo.O in let+ loc, include_dir = - match (include_dir : Include_dir_expanded.t) with + match (include_dir : Foreign.Stubs.Include_dir.Without_include.t) with | Dir dir -> Resolve.Memo.return (String_with_vars.loc dir, Expander.expand_path expander dir) @@ -161,8 +106,10 @@ let include_dir_flags ~expander ~dir (stubs : Foreign.Stubs.t) = Command.Args.Dyn (let open Action_builder.O in let+ include_dirs_expanded = - Action_builder.List.concat_map stubs.include_dirs - ~f:(expand_include_dir ~expander) + let expand_str = Expander.No_deps.expand_str expander in + Memo.List.concat_map stubs.include_dirs + ~f:(Foreign.Stubs.Include_dir.expand_include ~expand_str ~dir) + |> Action_builder.of_memo in Command.Args.S (List.map include_dirs_expanded ~f:args_of_include_dir)) diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index d3882109d29..4e1aa1bbadb 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -200,16 +200,24 @@ let define_all_alias ~dir ~project ~js_targets = let gen_rules sctx dir_contents cctxs expander { Dune_file.dir = src_dir; stanzas; project } ~dir:ctx_dir = - let files_to_install - { Install_conf.section = _; files; package = _; enabled_if = _; dirs } = - let* files_and_dirs = - Memo.List.map (files @ dirs) ~f:(fun fb -> - File_binding.Unexpanded.expand_src ~dir:ctx_dir fb - ~f:(Expander.No_deps.expand_str expander) - >>| Path.build) + let files_to_install install_conf = + let expand_str = Expander.No_deps.expand_str expander in + let files_and_dirs = + let* files_expanded = + Install_conf.expand_files install_conf ~expand_str ~dir:ctx_dir + in + let+ dirs_expanded = + Install_conf.expand_dirs install_conf ~expand_str ~dir:ctx_dir + in + List.map (files_expanded @ dirs_expanded) ~f:(fun fb -> + File_binding.Expanded.src fb |> Path.build) + in + let action = + let open Action_builder.O in + let* files_and_dirs = Action_builder.of_memo files_and_dirs in + Action_builder.paths files_and_dirs in - Rules.Produce.Alias.add_deps (Alias.all ~dir:ctx_dir) - (Action_builder.paths files_and_dirs) + Rules.Produce.Alias.add_deps (Alias.all ~dir:ctx_dir) action in let* { For_stanza.merlin = merlins ; cctx = cctxs diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index 3d0cd4471b9..2491f0279f6 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -274,14 +274,13 @@ end = struct let open Dune_file in match (stanza : Stanza.t) with | Install i | Executables { install_conf = Some i; _ } -> - let path_expander = - File_binding.Unexpanded.expand ~dir - ~f:(Expander.No_deps.expand_str expander) - in let section = i.section in + let expand_str = Expander.No_deps.expand_str expander in + let* files_expanded = + Dune_file.Install_conf.expand_files i ~expand_str ~dir + in let* files = - Memo.List.map i.files ~f:(fun unexpanded -> - let* fb = path_expander unexpanded in + Memo.List.map files_expanded ~f:(fun fb -> let loc = File_binding.Expanded.src_loc fb in let src = File_binding.Expanded.src fb in let dst = File_binding.Expanded.dst fb in @@ -292,9 +291,11 @@ end = struct in Install.Entry.Sourced.create ~loc entry) in + let* dirs_expanded = + Dune_file.Install_conf.expand_dirs i ~expand_str ~dir + in let+ files_from_dirs = - Memo.List.map i.dirs ~f:(fun unexpanded -> - let* fb = path_expander unexpanded in + Memo.List.map dirs_expanded ~f:(fun fb -> let loc = File_binding.Expanded.src_loc fb in let src = File_binding.Expanded.src fb in let dst = File_binding.Expanded.dst fb in @@ -931,11 +932,14 @@ let gen_package_install_file_rules sctx (package : Package.t) = let package_name = Package.name package in let roots = Install.Section.Paths.Roots.opam_from_prefix Path.root in let install_paths = Install.Section.Paths.make ~package:package_name ~roots in - let* entries = symlinked_entries sctx package >>| fst in + let entries = + Action_builder.of_memo (symlinked_entries sctx package >>| fst) + in let ctx = Super_context.context sctx in let pkg_build_dir = Package_paths.build_dir ctx package in let files = - List.map entries ~f:(fun (e : Install.Entry.Sourced.t) -> e.entry.src) + Action_builder.map entries + ~f:(List.map ~f:(fun (e : Install.Entry.Sourced.t) -> e.entry.src)) in let* dune_project = let+ scope = Scope.DB.find_by_dir pkg_build_dir in @@ -944,6 +948,7 @@ let gen_package_install_file_rules sctx (package : Package.t) = let strict_package_deps = Dune_project.strict_package_deps dune_project in let packages = let open Action_builder.O in + let* files = files in let+ packages = Action_builder.of_memo (package_deps package files) in (match strict_package_deps with | false -> () @@ -967,6 +972,8 @@ let gen_package_install_file_rules sctx (package : Package.t) = packages in let install_file_deps = + let open Action_builder.O in + let* files = files in Path.Set.of_list_map files ~f:Path.build |> Action_builder.path_set in let* () = @@ -1000,7 +1007,7 @@ let gen_package_install_file_rules sctx (package : Package.t) = if strict_package_deps then Action_builder.map packages ~f:(fun (_ : Package.Id.Set.t) -> ()) else Action_builder.return () - in + and+ entries = entries in let entries = match ctx.findlib_toolchain with | None -> entries diff --git a/src/dune_rules/recursive_include.ml b/src/dune_rules/recursive_include.ml new file mode 100644 index 00000000000..007c9afdd02 --- /dev/null +++ b/src/dune_rules/recursive_include.ml @@ -0,0 +1,98 @@ +open! Import + +module Include_term = struct + type t = + { context : Univ_map.t + ; path : String_with_vars.t + } + + let decode ~include_keyword ~allowed_in_versions = + let open Dune_lang.Decoder in + let version_check () = + match allowed_in_versions with + | `Since version -> Syntax.since Stanza.syntax version + | `All -> return () + in + sum + [ ( include_keyword + , let+ () = version_check () + and+ context = get_all + and+ path = String_with_vars.decode in + { context; path } ) + ] +end + +module Make (Base_term : sig + type t + + val decode : t Dune_lang.Decoder.t +end) (Config : sig + val include_keyword : string + + val include_allowed_in_versions : [ `Since of Syntax.Version.t | `All ] + + val non_sexp_behaviour : [ `User_error | `Parse_as_base_term ] +end) = +struct + type t = + | Base of Base_term.t + | Include of Include_term.t + + let of_base base = Base base + + let decode = + let open Dune_lang.Decoder in + let base_term_decode = + let+ base_term = Base_term.decode in + Base base_term + in + let include_term_decode = + let+ include_term = + Include_term.decode ~include_keyword:Config.include_keyword + ~allowed_in_versions:Config.include_allowed_in_versions + in + Include include_term + in + include_term_decode <|> base_term_decode + + let load_included_file path ~context = + let open Memo.O in + let+ contents = Build_system.read_file (Path.build path) ~f:Io.read_file in + let ast = + Dune_lang.Parser.parse_string contents ~mode:Single + ~fname:(Path.Build.to_string path) + in + let parse = Dune_lang.Decoder.parse decode context in + match ast with + | List (_loc, terms) -> List.map terms ~f:parse + | other -> ( + match Config.non_sexp_behaviour with + | `User_error -> + let loc = Dune_sexp.Ast.loc other in + User_error.raise ~loc [ Pp.textf "Expected list, got:\n%s" contents ] + | `Parse_as_base_term -> + let term = Dune_lang.Decoder.parse decode context other in + [ term ]) + + let expand_include t ~expand_str ~dir = + let rec expand_include t ~seen = + match t with + | Base base_term -> Memo.return [ base_term ] + | Include { context; path = path_sw } -> + let open Memo.O in + let* path = + expand_str path_sw + >>| Path.Build.relative ~error_loc:(String_with_vars.loc path_sw) dir + in + if Path.Build.Set.mem seen path then + User_error.raise + ~loc:(String_with_vars.loc path_sw) + [ Pp.textf "Include loop detected via: %s" + (Path.Build.to_string path) + ]; + let seen = Path.Build.Set.add seen path in + let* contents = load_included_file path ~context in + Memo.List.concat_map contents ~f:(expand_include ~seen) + in + expand_include t ~seen:Path.Build.Set.empty +end diff --git a/src/dune_rules/recursive_include.mli b/src/dune_rules/recursive_include.mli new file mode 100644 index 00000000000..0d2ad6cfb5c --- /dev/null +++ b/src/dune_rules/recursive_include.mli @@ -0,0 +1,51 @@ +(** Encapsulates the situation where you have a configuration language made up + of a sequence of terms (e.g. a list of directories to search for foreign + header files), and want to add a new term to the language (include ) + which parses a sexp list of terms in the same configuration language from + the file at and effectively replaces the (include ...) statement with + the result of parsing the file. Supports chains of recursively included + files, and detects include loops. *) + +open! Import + +module Make (Base_term : sig + (** The type of a term in the configuration language without (include ...) + terms *) + type t + + val decode : t Dune_lang.Decoder.t +end) (_ : sig + (** The keyword that will be used to identify an include statement (ie. the + "include" in (include ...)) *) + val include_keyword : string + + (** An expected use case for this module is adding (include ...) statements to + existing configuration languages used in dune fields, and in such cases + we'll want to assert that (include ...) statements are only used beyond a + particular version of dune. An error will be throw during parsing if an + (include ...) statement is encountered in versions of dune that don't + satisfy this predicate. *) + val include_allowed_in_versions : [ `Since of Syntax.Version.t | `All ] + + (** What to do if the included file doesn't contain a sexp *) + val non_sexp_behaviour : [ `User_error | `Parse_as_base_term ] +end) : sig + (** The type of terms in the configuration language obtained by adding + (include ...) statements to the base language *) + type t + + val of_base : Base_term.t -> t + + val decode : t Dune_lang.Decoder.t + + (** Recursively expands (include ...) terms in the language, producing a list + of terms in the original language (the language without (include ...) + statements). Paths referred to by (include ) are resolved relative + to [dir]. Paths are given as [String_with_vars.t], and the [expand_str] + function is used to resolve them to strings. *) + val expand_include : + t + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> Base_term.t list Memo.t +end diff --git a/test/blackbox-tests/test-cases/github4345.t b/test/blackbox-tests/test-cases/github4345.t new file mode 100644 index 00000000000..ac93353a7fe --- /dev/null +++ b/test/blackbox-tests/test-cases/github4345.t @@ -0,0 +1,15 @@ +This is a reproduction case from issue #4345. +This was a bug where using (copy_files ...) to depend on files from a parent +directory would cause in internal error in dune due to a dependency cycle. The +bug is now fixed, so this project should build without error. + + $ DIR="gh4345" + $ mkdir $DIR && cd $DIR + $ echo "(lang dune 2.8)" > dune-project + $ mkdir lib + $ touch lib.opam file lib/lib.ml + $ cat >lib/dune < (library (name lib) (public_name lib)) + > (copy_files (files ../file)) + > EOF + $ dune build --root . diff --git a/test/blackbox-tests/test-cases/install-include/install-include-chain.t b/test/blackbox-tests/test-cases/install-include/install-include-chain.t new file mode 100644 index 00000000000..dedb148649a --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include-chain.t @@ -0,0 +1,43 @@ +Including a file in the install stanza which includes another file + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (install + > (files (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ cat >foo.sexp < ((include bar.sexp)) + > EOF + + $ cat >bar.sexp < (a.txt) + > EOF + + $ touch a.txt + + $ dune build @install + + $ cat _build/default/hello.install + lib: [ + "_build/install/default/lib/hello/META" + "_build/install/default/lib/hello/dune-package" + ] + bin: [ + "_build/install/default/bin/hello" + ] + share: [ + "_build/install/default/share/hello/a.txt" + ] diff --git a/test/blackbox-tests/test-cases/install-include/install-include-dir.t b/test/blackbox-tests/test-cases/install-include/install-include-dir.t new file mode 100644 index 00000000000..87678a93976 --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include-dir.t @@ -0,0 +1,36 @@ +Example of including a file in the dirs field of the install stanza + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > (using directory-targets 0.1) + > EOF + + $ cat >dune < (install + > (dirs (include baz.sexp)) + > (section share)) + > EOF + + $ mkdir -p foo + + $ cat >foo/dune < (rule + > (target (dir bar)) + > (action (bash "mkdir %{target} && touch %{target}/a"))) + > EOF + + $ cat >baz.sexp < (foo/bar) + > EOF + + $ dune build @install + + $ cat _build/default/hello.install + lib: [ + "_build/install/default/lib/hello/META" + "_build/install/default/lib/hello/dune-package" + ] + share: [ + "_build/install/default/share/hello/bar/a" {"bar/a"} + ] diff --git a/test/blackbox-tests/test-cases/install-include/install-include-foo-as-bar.t b/test/blackbox-tests/test-cases/install-include/install-include-foo-as-bar.t new file mode 100644 index 00000000000..795c385bbb0 --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include-foo-as-bar.t @@ -0,0 +1,39 @@ +Include a file which contains the (foo as bar) syntax for renaming a file + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (install + > (files (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ cat >foo.sexp < ((a.txt as b/c.txt)) + > EOF + + $ touch a.txt + + $ dune build @install + + $ cat _build/default/hello.install + lib: [ + "_build/install/default/lib/hello/META" + "_build/install/default/lib/hello/dune-package" + ] + bin: [ + "_build/install/default/bin/hello" + ] + share: [ + "_build/install/default/share/hello/b/c.txt" {"b/c.txt"} + ] diff --git a/test/blackbox-tests/test-cases/install-include/install-include-generated-by-rule.t b/test/blackbox-tests/test-cases/install-include/install-include-generated-by-rule.t new file mode 100644 index 00000000000..dca29fcc1ea --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include-generated-by-rule.t @@ -0,0 +1,40 @@ +Including a file in the install stanza which is generated by a rule + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (rule + > (target foo.sexp) + > (action + > (with-stdout-to foo.sexp (echo "(a.txt)")))) + > + > (install + > (files (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ touch a.txt + + $ dune build @install + + $ cat _build/default/hello.install + lib: [ + "_build/install/default/lib/hello/META" + "_build/install/default/lib/hello/dune-package" + ] + bin: [ + "_build/install/default/bin/hello" + ] + share: [ + "_build/install/default/share/hello/a.txt" + ] diff --git a/test/blackbox-tests/test-cases/install-include/install-include-invalid-file.t b/test/blackbox-tests/test-cases/install-include/install-include-invalid-file.t new file mode 100644 index 00000000000..4e643cb6eef --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include-invalid-file.t @@ -0,0 +1,32 @@ +Including a file in the install stanza which does not contain a sexp list + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (install + > (files (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ cat >foo.sexp < a.txt + > EOF + + $ dune build @install + File "_build/default/foo.sexp", line 1, characters 0-5: + 1 | a.txt + ^^^^^ + Error: Expected list, got: + a.txt + + [1] diff --git a/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune new file mode 100644 index 00000000000..5aff9637e74 --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune @@ -0,0 +1,9 @@ +(install + (files (include resources.sexp)) + (section share)) + +(rule + (deps (source_tree resources) list_dir.ml) + (action + (with-stdout-to resources.sexp + (run ocaml list_dir.ml resources)))) diff --git a/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune-project b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune-project new file mode 100644 index 00000000000..8f9dd06899e --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) +(package (name foo)) diff --git a/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/list_dir.ml b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/list_dir.ml new file mode 100644 index 00000000000..41c172346f9 --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/list_dir.ml @@ -0,0 +1,19 @@ +(* Prints a sexp listing the contents of a given directory in the form: + + ((dir/foo as dir/foo) + (dir/bar as dir/bar) + (dir/baz as dir/baz) + ...) + + where foo, bar, baz, ... are files in the given directory. *) + +let list_dir dir = + Sys.readdir dir + |> Array.to_list + |> List.map (fun f -> String.concat "/" [dir; f]) + +let () = + list_dir (Sys.argv.(1)) + |> List.map (fun f -> Printf.sprintf "(%s as %s)" f f ) + |> String.concat " " + |> Printf.printf "(%s)" diff --git a/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/a.txt b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/a.txt new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/b.txt b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/b.txt new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/c.txt b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/c.txt new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/run.t b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/run.t new file mode 100644 index 00000000000..8bca5cb7856 --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/run.t @@ -0,0 +1,21 @@ +Include a file generated by listing the contents of a directory. + + $ dune build @install + + $ cat _build/default/foo.install + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + ] + share: [ + "_build/install/default/share/foo/resources/a.txt" {"resources/a.txt"} + "_build/install/default/share/foo/resources/b.txt" {"resources/b.txt"} + "_build/install/default/share/foo/resources/c.txt" {"resources/c.txt"} + ] + $ find _build/install/default/share | sort + _build/install/default/share + _build/install/default/share/foo + _build/install/default/share/foo/resources + _build/install/default/share/foo/resources/a.txt + _build/install/default/share/foo/resources/b.txt + _build/install/default/share/foo/resources/c.txt diff --git a/test/blackbox-tests/test-cases/install-include/install-include-loop.t b/test/blackbox-tests/test-cases/install-include/install-include-loop.t new file mode 100644 index 00000000000..263952d36c9 --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include-loop.t @@ -0,0 +1,34 @@ +Detect include loops in files included in the install stanza + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (install + > (files (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ cat >foo.sexp < ((include bar.sexp)) + > EOF + + $ cat >bar.sexp < ((include foo.sexp)) + > EOF + + $ dune build @install + File "_build/default/bar.sexp", line 1, characters 10-18: + 1 | ((include foo.sexp)) + ^^^^^^^^ + Error: Include loop detected via: _build/default/foo.sexp + [1] diff --git a/test/blackbox-tests/test-cases/install-include/install-include.t b/test/blackbox-tests/test-cases/install-include/install-include.t new file mode 100644 index 00000000000..613e1166906 --- /dev/null +++ b/test/blackbox-tests/test-cases/install-include/install-include.t @@ -0,0 +1,70 @@ +Simple example of including a file in the install stanza + + $ cat >dune-project < (lang dune 3.4) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (install + > (files a.txt (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ touch a.txt + + $ dune build @install + File "dune", line 5, characters 14-32: + 5 | (files a.txt (include foo.sexp)) + ^^^^^^^^^^^^^^^^^^ + Error: 'include' is only available since version 3.5 of the dune language. + Please update your dune-project file to have (lang dune 3.5). + [1] + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ dune build @install + File "_unknown_", line 1, characters 0-0: + Error: No rule found for foo.sexp + [1] + + $ cat >foo.sexp < (b.txt c.txt) + > EOF + + $ touch b.txt + + $ dune build @install + File "_build/default/foo.sexp", line 1, characters 7-12: + 1 | (b.txt c.txt) + ^^^^^ + Error: No rule found for c.txt + [1] + + $ touch c.txt + + $ dune build @install + + $ cat _build/default/hello.install + lib: [ + "_build/install/default/lib/hello/META" + "_build/install/default/lib/hello/dune-package" + ] + bin: [ + "_build/install/default/bin/hello" + ] + share: [ + "_build/install/default/share/hello/a.txt" + "_build/install/default/share/hello/b.txt" + "_build/install/default/share/hello/c.txt" + ] diff --git a/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t b/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t index e94b8e12160..e630fee88ae 100644 --- a/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t +++ b/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t @@ -67,22 +67,3 @@ cryptic and can involve unrelated files: -> required by _build/default/indirect/a.exe -> required by alias indirect/indirect-deps in indirect/dune:6 [1] - -This is a reproduction case from issue #4345 - $ DIR="gh4345" - $ mkdir $DIR && cd $DIR - $ echo "(lang dune 2.8)" > dune-project - $ mkdir lib - $ touch lib.opam file lib/lib.ml - $ cat >lib/dune < (library (name lib) (public_name lib)) - > (copy_files (files ../file)) - > EOF - $ dune build --root . - Error: Dependency cycle between: - Computing installable artifacts for package lib - -> Evaluating predicate in directory _build/default - -> Computing directory contents of _build/default/lib - -> Computing installable artifacts for package lib - [1] - $ cd ..