From 282c0b3c415246d95ae409d24bd05b0ee7286f99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Wed, 1 Aug 2018 15:23:26 +0100 Subject: [PATCH] Add support for multi directory libraries and executables (#1034) Signed-off-by: Jeremie Dimino --- CHANGES.md | 3 + doc/dune-files.rst | 42 +++ src/build_system.ml | 1 + src/dir_contents.ml | 244 ++++++++++++++++-- src/dir_contents.mli | 13 + src/gen_rules.ml | 83 ++++-- src/jbuild.ml | 44 ++-- src/jbuild.mli | 25 +- src/module.ml | 8 + src/module.mli | 2 + test/blackbox-tests/dune.inc | 10 + .../blackbox-tests/test-cases/github734/run.t | 3 +- .../test-cases/multi-dir/error1/a/x.ml | 1 + .../test-cases/multi-dir/error1/b/x.ml | 1 + .../test-cases/multi-dir/error1/dune | 3 + .../test-cases/multi-dir/error1/dune-project | 1 + .../test-cases/multi-dir/error2/dune | 2 + .../test-cases/multi-dir/error2/dune-project | 1 + .../blackbox-tests/test-cases/multi-dir/run.t | 40 +++ .../test-cases/multi-dir/test1/dune | 3 + .../test-cases/multi-dir/test1/dune-project | 1 + .../test-cases/multi-dir/test1/src/a/b/y.ml | 1 + .../test-cases/multi-dir/test1/src/c/z.ml | 1 + .../test-cases/multi-dir/test1/src/dune | 2 + .../test-cases/multi-dir/test1/src/foo.ml | 1 + .../test-cases/multi-dir/test1/src/x.ml | 1 + .../test-cases/multi-dir/test2/dune | 7 + .../test-cases/multi-dir/test2/dune-project | 1 + .../test-cases/multi-dir/test2/main.ml | 1 + .../test-cases/multi-dir/test2/src/a/blah.ml | 1 + .../test-cases/multi-dir/test2/src/dune | 5 + .../test-cases/multi-dir/test2/src/foo.ml | 1 + .../test-cases/multi-dir/test2/src/gen/dune | 1 + .../test-cases/multi-dir/test2/src/gen/gen.ml | 1 + .../test-cases/multi-dir/test3/dune | 11 + .../test-cases/multi-dir/test3/dune-project | 1 + .../test-cases/multi-dir/test3/foo.ml | 2 + .../multi-dir/test3/include/dune_test.h | 2 + .../test-cases/multi-dir/test3/main.ml | 1 + .../test-cases/multi-dir/test3/stub1.c | 6 + .../test-cases/multi-dir/test3/sub/stub2.c | 6 + 41 files changed, 506 insertions(+), 78 deletions(-) create mode 100644 test/blackbox-tests/test-cases/multi-dir/error1/a/x.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/error1/b/x.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/error1/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/error1/dune-project create mode 100644 test/blackbox-tests/test-cases/multi-dir/error2/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/error2/dune-project create mode 100644 test/blackbox-tests/test-cases/multi-dir/run.t create mode 100644 test/blackbox-tests/test-cases/multi-dir/test1/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/test1/dune-project create mode 100644 test/blackbox-tests/test-cases/multi-dir/test1/src/a/b/y.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/test1/src/c/z.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/test1/src/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/test1/src/foo.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/test1/src/x.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/test2/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/test2/dune-project create mode 100644 test/blackbox-tests/test-cases/multi-dir/test2/main.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/test2/src/a/blah.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/test2/src/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/test2/src/foo.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/test2/src/gen/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/test2/src/gen/gen.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/test3/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/test3/dune-project create mode 100644 test/blackbox-tests/test-cases/multi-dir/test3/foo.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/test3/include/dune_test.h create mode 100644 test/blackbox-tests/test-cases/multi-dir/test3/main.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/test3/stub1.c create mode 100644 test/blackbox-tests/test-cases/multi-dir/test3/sub/stub2.c diff --git a/CHANGES.md b/CHANGES.md index 430ae8f9..0b9dbaab 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -18,6 +18,9 @@ next - Interpret `X` in `--libdir X` as relative to `PREFIX` when `X` is relative (#1072, fix #1070, @diml) +- Add support for multi directory libraries by writing + `(include_subdirs qualified)` (#1034, @diml) + 1.0.1 (19/07/2018) ------------------ diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 9ed1feb4..9d7cc047 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -57,6 +57,11 @@ allowed to write an explicit ``Foo`` module, in which case this will be the interface of the library and you are free to expose only the modules you want. +Note that by default libraries and other things that consume +OCaml/Reason modules only consume modules from the directory where the +stanza appear. In order to declare a multi-directory library, you need +to use the :ref:`include_subdirs` stanza. + ```` are: - ``(public_name )`` this is the name under which the library can be @@ -787,6 +792,43 @@ A directory that is ignored will not be eagerly scanned by Dune. Any will be treated as raw data. It is however possible to depend on files inside ignored sub-directories. +.. _include_subdirs: + +include_subdirs +--------------- + +The ``include_subdirs`` stanza is used to control how dune considers +sub-directories of the current directory. The syntax is as follow: + +.. code:: scheme + + (include_subdirs ) + +Where ```` maybe be one of: + +- ``no``, the default +- ``unqualified`` + +When the ``include_subdirs`` stanza is not present or ```` is +``no``, dune considers sub-directories as independent. When ```` +is ``unqualified``, dune will assume that the sub-directories of the +current directory are part of the same group of directories. In +particular, dune will scan all these directories at once when looking +for OCaml/Reason files. This allows you to split a library between +several directories. ``unqualified`` means that modules in +sub-directories are seen as if they were all in the same directory. In +particular, you cannot have two modules with the same name in two +different directories. It is planned to add a ``qualified`` mode in +the future. + +Note that sub-directories are included recursively, however the +recursion will stop when encountering a sub-directory that: + +- is part of a different project (for instance when vendoring projects) +- contains ``(include_subdirs unqualified)`` +- contains one of the following stanza that consume modules: + ``library``, ``executable(s)`` or ``test(s)``. + Common items ============ diff --git a/src/build_system.ml b/src/build_system.ml index 1f4e4bbd..bd76f712 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -1534,6 +1534,7 @@ let get_collector t ~dir = else "Build_system.get_collector called on closed directory") [ "dir", Path.sexp_of_t dir + ; "load_dir_stack", Sexp.To_sexp.list Path.sexp_of_t t.load_dir_stack ] let add_rule t (rule : Build_interpret.Rule.t) = diff --git a/src/dir_contents.ml b/src/dir_contents.ml index 2debaeb9..6f1e0573 100644 --- a/src/dir_contents.ml +++ b/src/dir_contents.ml @@ -180,12 +180,34 @@ type modules = rev_map : Buildable.t Module.Name.Map.t } +let empty_modules = + { libraries = String.Map.empty + ; executables = String.Map.empty + ; rev_map = Module.Name.Map.empty + } type t = - { text_files : String.Set.t + { kind : kind + ; dir : Path.t + ; text_files : String.Set.t ; modules : modules Lazy.t ; mlds : (Jbuild.Documentation.t * Path.t list) list Lazy.t } +and kind = + | Standalone + | Group_root of t list Lazy.t + | Group_part of t + +let kind t = t.kind +let dir t = t.dir + +let dirs t = + match t.kind with + | Standalone -> [t] + | Group_root (lazy l) + | Group_part { kind = Group_root (lazy l); _ } -> t :: l + | Group_part { kind = _; _ } -> assert false + let text_files t = t.text_files let modules_of_library t ~name = @@ -226,7 +248,7 @@ let mlds t (doc : Documentation.t) = ] (* As a side-effect, setup user rules and copy_files rules. *) -let load_text_files sctx d = +let load_text_files sctx ft_dir d = let { Super_context.Dir_with_jbuild. ctx_dir = dir ; src_dir @@ -258,8 +280,7 @@ let load_text_files sctx d = | _ -> []) |> String.Set.of_list in - String.Set.union generated_files - (Super_context.source_files sctx ~src_path:src_dir) + String.Set.union generated_files (File_tree.Dir.files ft_dir) let modules_of_files ~dir ~files = let make_module syntax base fn = @@ -296,8 +317,7 @@ let modules_of_files ~dir ~files = Module.Name.Map.merge impls intfs ~f:(fun name impl intf -> Some (Module.make name ?impl ?intf)) -let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~files = - let modules = modules_of_files ~dir:d.ctx_dir ~files in +let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules = let libs, exes = List.filter_partition_map d.stanzas ~f:(fun stanza -> match (stanza : Stanza.t) with @@ -427,23 +447,201 @@ let build_mlds_map (d : Super_context.Dir_with_jbuild.t) ~files = Some (doc, List.map (String.Map.values mlds) ~f:(Path.relative dir)) | _ -> None) -let get = - let cache = Hashtbl.create 32 in - fun sctx ~dir -> - Hashtbl.find_or_add cache dir ~f:(fun dir -> - match Super_context.stanzas_in sctx ~dir with - | None -> - { text_files = String.Set.empty - ; modules = lazy - { libraries = String.Map.empty - ; executables = String.Map.empty - ; rev_map = Module.Name.Map.empty - } +module Dir_status = struct + type t = + | Empty_standalone of File_tree.Dir.t option + (* Directory with no libraries or executables that is not part of + a multi-directory group *) + + | Is_component_of_a_group_but_not_the_root of + Super_context.Dir_with_jbuild.t option + (* Sub-directory of a directory with [(include_subdirs x)] where + [x] is not [no] *) + + | Standalone of File_tree.Dir.t + * Super_context.Dir_with_jbuild.t + (* Directory with at least one library or executable *) + + | Group_root of File_tree.Dir.t + * Super_context.Dir_with_jbuild.t + (* Directory with [(include_subdirs x)] where [x] is not [no] *) + + let is_standalone = function + | Standalone _ | Empty_standalone _ -> true + | _ -> false + + let cache = Hashtbl.create 32 + + let analyze_stanzas stanzas = + let is_group_root, has_modules_consumers = + List.fold_left stanzas ~init:(None, false) ~f:(fun acc stanza -> + let is_group_root, has_modules_consumers = acc in + match stanza with + | Include_subdirs (loc, x) -> + if Option.is_some is_group_root then + Loc.fail loc "The 'include_subdirs' stanza cannot appear \ + more than once"; + (Some x, has_modules_consumers) + | Library _ | Executables _ | Tests _ -> + (is_group_root, true) + | _ -> acc) + in + (Option.value is_group_root ~default:No, has_modules_consumers) + + let rec get sctx ~dir = + match Hashtbl.find cache dir with + | Some t -> t + | None -> + let t = + match + Option.bind (Path.drop_build_context dir) + ~f:(File_tree.find_dir (Super_context.file_tree sctx)) + with + | None -> Empty_standalone None + | Some ft_dir -> + let project_root = Path.of_local (File_tree.Dir.project ft_dir).root in + match Super_context.stanzas_in sctx ~dir with + | None -> + if dir = project_root || + is_standalone (get sctx ~dir:(Path.parent_exn dir)) then + Empty_standalone (Some ft_dir) + else + Is_component_of_a_group_but_not_the_root None + | Some d -> + let is_group_root, has_modules_consumers = + analyze_stanzas d.stanzas + in + if is_group_root <> No then + Group_root (ft_dir, d) + else if not has_modules_consumers && + dir <> project_root && + not (is_standalone (get sctx ~dir:(Path.parent_exn dir))) + then + Is_component_of_a_group_but_not_the_root (Some d) + else + Standalone (ft_dir, d) + in + Hashtbl.add cache dir t; + t + + let get_assuming_parent_is_part_of_group sctx ~dir ft_dir = + match Hashtbl.find cache (File_tree.Dir.path ft_dir) with + | Some t -> t + | None -> + let t = + match Super_context.stanzas_in sctx ~dir with + | None -> Is_component_of_a_group_but_not_the_root None + | Some d -> + let is_group_root, has_modules_consumers = + analyze_stanzas d.stanzas + in + if is_group_root <> No then + Group_root (ft_dir, d) + else if has_modules_consumers then + Standalone (ft_dir, d) + else + Is_component_of_a_group_but_not_the_root (Some d) + in + Hashtbl.add cache dir t; + t +end + +let cache = Hashtbl.create 32 + +let rec get sctx ~dir = + match Hashtbl.find cache dir with + | Some t -> t + | None -> + match Dir_status.get sctx ~dir with + | Empty_standalone ft_dir -> + let t = + { kind = Standalone + ; dir + ; text_files = + (match ft_dir with + | None -> String.Set.empty + | Some x -> File_tree.Dir.files x) + ; modules = lazy empty_modules ; mlds = lazy [] } - | Some d -> - let files = load_text_files sctx d in - { text_files = files - ; modules = lazy (build_modules_map d ~files) + in + Hashtbl.add cache dir t; + t + | Is_component_of_a_group_but_not_the_root _ -> + (* Filled while scanning the group root *) + Option.value_exn (Hashtbl.find cache dir) + | Standalone (ft_dir, d) -> + let files = load_text_files sctx ft_dir d in + let t = + { kind = Standalone + ; dir + ; text_files = files + ; modules = lazy (build_modules_map d + ~modules:(modules_of_files ~dir:d.ctx_dir ~files)) ; mlds = lazy (build_mlds_map d ~files) - }) + } + in + Hashtbl.add cache dir t; + t + | Group_root (ft_dir, d) -> + let rec walk ft_dir ~dir acc = + match + Dir_status.get_assuming_parent_is_part_of_group sctx ft_dir ~dir + with + | Is_component_of_a_group_but_not_the_root d -> + let files = + match d with + | None -> File_tree.Dir.files ft_dir + | Some d -> load_text_files sctx ft_dir d + in + walk_children ft_dir ~dir ((dir, files) :: acc) + | _ -> acc + and walk_children ft_dir ~dir acc = + String.Map.foldi (File_tree.Dir.sub_dirs ft_dir) ~init:acc + ~f:(fun name ft_dir acc -> + let dir = Path.relative dir name in + walk ft_dir ~dir acc) + in + let files = load_text_files sctx ft_dir d in + let subdirs = walk_children ft_dir ~dir [] in + let modules = lazy ( + let modules = + List.fold_left ((dir, files) :: subdirs) ~init:Module.Name.Map.empty + ~f:(fun acc (dir, files) -> + let modules = modules_of_files ~dir ~files in + Module.Name.Map.union acc modules ~f:(fun name x y -> + Loc.fail (Loc.in_file + (Path.to_string + (match File_tree.Dir.dune_file ft_dir with + | None -> + Path.relative (File_tree.Dir.path ft_dir) + "_unknown_" + | Some d -> File_tree.Dune_file.path d))) + "Module %a appears in several directories:\ + @\n- %a\ + @\n- %a" + Module.Name.pp_quote name + Path.pp (Module.dir x) + Path.pp (Module.dir y))) + in + build_modules_map d ~modules) + in + let t = + { kind = Group_root + (lazy (List.map subdirs ~f:(fun (dir, _) -> get sctx ~dir))) + ; dir + ; text_files = files + ; modules + ; mlds = lazy (build_mlds_map d ~files) + } + in + Hashtbl.add cache dir t; + List.iter subdirs ~f:(fun (dir, files) -> + Hashtbl.add cache dir + { kind = Group_part t + ; dir + ; text_files = files + ; modules + ; mlds = lazy (build_mlds_map d ~files) + }); + t diff --git a/src/dir_contents.mli b/src/dir_contents.mli index 9bb8f9ab..d7202b91 100644 --- a/src/dir_contents.mli +++ b/src/dir_contents.mli @@ -8,6 +8,8 @@ open Import type t +val dir : t -> Path.t + (** Files in this directory. At the moment, this doesn't include all generated files, just the ones generated by [rule], [ocamllex], [ocamlyacc], [menhir] stanzas. *) @@ -38,3 +40,14 @@ val lookup_module : t -> Module.Name.t -> Jbuild.Buildable.t option val mlds : t -> Jbuild.Documentation.t -> Path.t list val get : Super_context.t -> dir:Path.t -> t + +type kind = + | Standalone + | Group_root of t list Lazy.t (** Sub-directories part of the group *) + | Group_part of t + +val kind : t -> kind + +(** All directories in this group, or just [t] if this directory is + not part of a group. *) +val dirs : t -> t list diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 138718e5..cd5198f3 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -97,9 +97,7 @@ module Gen(P : Install_rules.Params) = struct | Native -> [Library.archive lib ~dir ~ext:ctx.ext_lib]) ])) - let build_c_file (lib : Library.t) ~scope ~dir ~includes c_name = - let src = Path.relative dir (c_name ^ ".c") in - let dst = Path.relative dir (c_name ^ ctx.ext_obj) in + let build_c_file (lib : Library.t) ~scope ~dir ~includes (src, dst) = SC.add_rule sctx (SC.expand_and_eval_set sctx ~scope ~dir lib.c_flags ~standard:(Build.return (Context.cc_g ctx)) @@ -107,7 +105,7 @@ module Gen(P : Install_rules.Params) = struct Build.run ~context:ctx (* We have to execute the rule in the library directory as the .o is produced in the current directory *) - ~dir + ~dir:(Path.parent_exn src) (Ok ctx.ocamlc) [ As (Utils.g ()) ; includes @@ -117,9 +115,7 @@ module Gen(P : Install_rules.Params) = struct ]); dst - let build_cxx_file (lib : Library.t) ~scope ~dir ~includes c_name = - let src = Path.relative dir (c_name ^ ".cpp") in - let dst = Path.relative dir (c_name ^ ctx.ext_obj) in + let build_cxx_file (lib : Library.t) ~scope ~dir ~includes (src, dst) = let open Arg_spec in let output_param = if ctx.ccomp_type = "msvc" then @@ -134,7 +130,7 @@ module Gen(P : Install_rules.Params) = struct Build.run ~context:ctx (* We have to execute the rule in the library directory as the .o is produced in the current directory *) - ~dir + ~dir:(Path.parent_exn src) (SC.resolve_program sctx ctx.c_compiler) ([ S [A "-I"; Path ctx.stdlib_dir] ; As (SC.cxx_flags sctx) @@ -240,13 +236,28 @@ module Gen(P : Install_rules.Params) = struct ~dep_graphs:(Ocamldep.Dep_graphs.dummy m)); if Library.has_stubs lib then begin + let all_dirs = Dir_contents.dirs dir_contents in let h_files = - String.Set.to_list (Dir_contents.text_files dir_contents) - |> List.filter_map ~f:(fun fn -> - if String.is_suffix fn ~suffix:".h" then - Some (Path.relative dir fn) - else - None) + List.fold_left all_dirs ~init:[] ~f:(fun acc dc -> + String.Set.fold (Dir_contents.text_files dc) ~init:acc + ~f:(fun fn acc -> + if String.is_suffix fn ~suffix:".h" then + Path.relative (Dir_contents.dir dc) fn :: acc + else + acc)) + in + let all_dirs = Path.Set.of_list (List.map all_dirs ~f:Dir_contents.dir) in + let resolve_name ~ext (loc, fn) = + let p = Path.relative dir (fn ^ ext) in + if not (match Path.parent p with + | None -> false + | Some p -> Path.Set.mem all_dirs p) then + Loc.fail loc + "File %a is not part of the current directory group. \ + This is not allowed." + Path.pp (Path.drop_optional_build_context p) + ; + (p, Path.relative dir (fn ^ ctx.ext_obj)) in let o_files = let includes = @@ -258,10 +269,10 @@ module Gen(P : Install_rules.Params) = struct ]) ] in - List.map lib.c_names ~f:( - build_c_file lib ~scope ~dir ~includes - ) @ List.map lib.cxx_names ~f:( - build_cxx_file lib ~scope ~dir ~includes + List.map lib.c_names ~f:(fun name -> + build_c_file lib ~scope ~dir ~includes (resolve_name name ~ext:".c") + ) @ List.map lib.cxx_names ~f:(fun name -> + build_cxx_file lib ~scope ~dir ~includes (resolve_name name ~ext:".cpp") ) in match lib.self_build_stubs_archive with @@ -610,9 +621,8 @@ module Gen(P : Install_rules.Params) = struct | Stanza | +-----------------------------------------------------------------+ *) - let gen_rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope; kind } = - (* This interprets "rule" and "copy_files" stanzas. *) - let dir_contents = Dir_contents.get sctx ~dir:ctx_dir in + let gen_rules dir_contents + { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope; kind } = let merlins, cctxs = let rec loop stanzas merlins cctxs = let dir = ctx_dir in @@ -696,6 +706,11 @@ module Gen(P : Install_rules.Params) = struct end | _ -> ()) + let gen_rules dir_contents ~dir = + match SC.stanzas_in sctx ~dir with + | None -> () + | Some d -> gen_rules dir_contents d + let gen_rules ~dir components : Build_system.extra_sub_directories_to_keep = (match components with | ".js" :: rest -> Js_of_ocaml_rules.setup_separate_compilation_rules @@ -703,14 +718,26 @@ module Gen(P : Install_rules.Params) = struct | "_doc" :: rest -> Odoc.gen_rules rest ~dir | ".ppx" :: rest -> Preprocessing.gen_rules sctx rest | _ -> - match SC.stanzas_in sctx ~dir with - | Some x -> gen_rules x + match + File_tree.find_dir (SC.file_tree sctx) + (Path.drop_build_context_exn dir) + with | None -> - if components <> [] && - Option.is_none - (File_tree.find_dir (SC.file_tree sctx) - (Path.drop_build_context_exn dir)) then - SC.load_dir sctx ~dir:(Path.parent_exn dir)); + (* We get here when [dir] is a generated directory, such as + [.utop] or [.foo.objs]. *) + if components <> [] then SC.load_dir sctx ~dir:(Path.parent_exn dir) + | Some _ -> + (* This interprets "rule" and "copy_files" stanzas. *) + let dir_contents = Dir_contents.get sctx ~dir in + match Dir_contents.kind dir_contents with + | Standalone -> + gen_rules dir_contents ~dir + | Group_part root -> + SC.load_dir sctx ~dir:(Dir_contents.dir root) + | Group_root (lazy subs) -> + gen_rules dir_contents ~dir; + List.iter subs ~f:(fun dc -> + gen_rules dir_contents ~dir:(Dir_contents.dir dc))); match components with | [] -> These (String.Set.of_list [".js"; "_doc"; ".ppx"]) | [(".js"|"_doc"|".ppx")] -> All diff --git a/src/jbuild.ml b/src/jbuild.ml index 4b186194..0ed0d827 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -83,14 +83,12 @@ let c_name, cxx_name = plain_string (fun ~loc s -> if match s with | "" | "." | ".." -> true - | _ -> Filename.basename s <> s then + | _ -> false then of_sexp_errorf loc - "%S is not a valid %s name.\n\ - Hint: To use %s files from another directory, use a \ - (copy_files /*.%s) stanza instead." + "%S is not a valid %s name." s what what ext else - s) + (loc, s)) in (make "C" "c", make "C++" "cpp") @@ -836,9 +834,9 @@ module Library = struct ; modes : Mode_conf.Set.t ; kind : Kind.t ; c_flags : Ordered_set_lang.Unexpanded.t - ; c_names : string list + ; c_names : (Loc.t * string) list ; cxx_flags : Ordered_set_lang.Unexpanded.t - ; cxx_names : string list + ; cxx_names : (Loc.t * string) list ; library_flags : Ordered_set_lang.Unexpanded.t ; c_library_flags : Ordered_set_lang.Unexpanded.t ; self_build_stubs_archive : string option @@ -1644,15 +1642,26 @@ module Documentation = struct ) end +module Include_subdirs = struct + type t = No | Unqualified + + let t = + enum + [ "no", No + ; "unqualified", Unqualified + ] +end + type Stanza.t += - | Library of Library.t - | Executables of Executables.t - | Rule of Rule.t - | Install of Install_conf.t - | Alias of Alias_conf.t - | Copy_files of Copy_files.t - | Documentation of Documentation.t - | Tests of Tests.t + | Library of Library.t + | Executables of Executables.t + | Rule of Rule.t + | Install of Install_conf.t + | Alias of Alias_conf.t + | Copy_files of Copy_files.t + | Documentation of Documentation.t + | Tests of Tests.t + | Include_subdirs of Loc.t * Include_subdirs.t module Stanzas = struct type t = Stanza.t list @@ -1722,6 +1731,11 @@ module Stanzas = struct ; "env", (let%map x = Dune_env.Stanza.t in [Dune_env.T x]) + ; "include_subdirs", + (let%map () = Syntax.since Stanza.syntax (1, 1) + and t = Include_subdirs.t + and loc = loc in + [Include_subdirs (loc, t)]) ] let jbuild_parser = diff --git a/src/jbuild.mli b/src/jbuild.mli index dcf64192..537674c0 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -215,9 +215,9 @@ module Library : sig ; modes : Mode_conf.Set.t ; kind : Kind.t ; c_flags : Ordered_set_lang.Unexpanded.t - ; c_names : string list + ; c_names : (Loc.t * string) list ; cxx_flags : Ordered_set_lang.Unexpanded.t - ; cxx_names : string list + ; cxx_names : (Loc.t * string) list ; library_flags : Ordered_set_lang.Unexpanded.t ; c_library_flags : Ordered_set_lang.Unexpanded.t ; self_build_stubs_archive : string option @@ -365,15 +365,20 @@ module Tests : sig } end +module Include_subdirs : sig + type t = No | Unqualified +end + type Stanza.t += - | Library of Library.t - | Executables of Executables.t - | Rule of Rule.t - | Install of Install_conf.t - | Alias of Alias_conf.t - | Copy_files of Copy_files.t - | Documentation of Documentation.t - | Tests of Tests.t + | Library of Library.t + | Executables of Executables.t + | Rule of Rule.t + | Install of Install_conf.t + | Alias of Alias_conf.t + | Copy_files of Copy_files.t + | Documentation of Documentation.t + | Tests of Tests.t + | Include_subdirs of Loc.t * Include_subdirs.t module Stanzas : sig type t = Stanza.t list diff --git a/src/module.ml b/src/module.ml index bf690ac9..1a3eb2ce 100644 --- a/src/module.ml +++ b/src/module.ml @@ -118,3 +118,11 @@ let map_files t ~f = impl = Option.map t.impl ~f:(f Ml_kind.Impl) ; intf = Option.map t.intf ~f:(f Ml_kind.Intf) } + +let dir t = + let file = + match t.intf with + | Some x -> x + | None -> Option.value_exn t.impl + in + Path.parent_exn file.path diff --git a/src/module.mli b/src/module.mli index e09f6182..2939f477 100644 --- a/src/module.mli +++ b/src/module.mli @@ -65,6 +65,8 @@ val cmt_file : t -> obj_dir:Path.t -> Ml_kind.t -> Path.t option val obj_file : t -> obj_dir:Path.t -> ext:string -> Path.t +val dir : t -> Path.t + (** Same as [cm_file] but doesn't raise if [cm_kind] is [Cmo] or [Cmx] and the module has no implementation. *) val cm_file_unsafe : t -> obj_dir:Path.t -> Cm_kind.t -> Path.t diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 2b99fa5d..fe593bba 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -448,6 +448,14 @@ test-cases/misc (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name multi-dir) + (deps (package dune) (source_tree test-cases/multi-dir)) + (action + (chdir + test-cases/multi-dir + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name multiple-private-libs) (deps (package dune) (source_tree test-cases/multiple-private-libs)) @@ -781,6 +789,7 @@ (alias merlin-tests) (alias meta-gen) (alias misc) + (alias multi-dir) (alias multiple-private-libs) (alias no-installable-mode) (alias no-name-field) @@ -869,6 +878,7 @@ (alias merlin-tests) (alias meta-gen) (alias misc) + (alias multi-dir) (alias no-installable-mode) (alias no-name-field) (alias null-dep) diff --git a/test/blackbox-tests/test-cases/github734/run.t b/test/blackbox-tests/test-cases/github734/run.t index d736db42..854308c4 100644 --- a/test/blackbox-tests/test-cases/github734/run.t +++ b/test/blackbox-tests/test-cases/github734/run.t @@ -1,5 +1,4 @@ $ jbuilder build @foo File "src/dune", line 4, characters 10-17: - Error: "stubs/x" is not a valid C name. - Hint: To use C files from another directory, use a (copy_files /*.c) stanza instead. + Error: File src/stubs/x.c is not part of the current directory group. This is not allowed. [1] diff --git a/test/blackbox-tests/test-cases/multi-dir/error1/a/x.ml b/test/blackbox-tests/test-cases/multi-dir/error1/a/x.ml new file mode 100644 index 00000000..0547b3d0 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error1/a/x.ml @@ -0,0 +1 @@ +let x = 1 diff --git a/test/blackbox-tests/test-cases/multi-dir/error1/b/x.ml b/test/blackbox-tests/test-cases/multi-dir/error1/b/x.ml new file mode 100644 index 00000000..0547b3d0 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error1/b/x.ml @@ -0,0 +1 @@ +let x = 1 diff --git a/test/blackbox-tests/test-cases/multi-dir/error1/dune b/test/blackbox-tests/test-cases/multi-dir/error1/dune new file mode 100644 index 00000000..773baeea --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error1/dune @@ -0,0 +1,3 @@ +(library (name foo)) + +(include_subdirs unqualified) diff --git a/test/blackbox-tests/test-cases/multi-dir/error1/dune-project b/test/blackbox-tests/test-cases/multi-dir/error1/dune-project new file mode 100644 index 00000000..6687faf2 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error1/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/multi-dir/error2/dune b/test/blackbox-tests/test-cases/multi-dir/error2/dune new file mode 100644 index 00000000..0f4939dd --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error2/dune @@ -0,0 +1,2 @@ +(include_subdirs unqualified) +(include_subdirs unqualified) diff --git a/test/blackbox-tests/test-cases/multi-dir/error2/dune-project b/test/blackbox-tests/test-cases/multi-dir/error2/dune-project new file mode 100644 index 00000000..7655de07 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error2/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) diff --git a/test/blackbox-tests/test-cases/multi-dir/run.t b/test/blackbox-tests/test-cases/multi-dir/run.t new file mode 100644 index 00000000..c3d21ea6 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/run.t @@ -0,0 +1,40 @@ +Simple test with a multi dir exe +-------------------------------- + + $ dune build --root test1 + Entering directory 'test1' + foo alias default + Hello, world! + +Test that executables stop the recursion +---------------------------------------- + + $ dune build --root test2 + Entering directory 'test2' + main alias default + Hello, world! + +Test with C stubs in sub-directories +------------------------------------ + + $ dune runtest --root test3 + Entering directory 'test3' + main alias runtest + Hello, world! + +Test some error cases +--------------------- + + $ dune build --root error1 + Entering directory 'error1' + File "dune", line 1, characters 0-0: + Error: Module "X" appears in several directories: + - _build/default/b + - _build/default/a + [1] + + $ dune build --root error2 + Entering directory 'error2' + File "dune", line 2, characters 0-29: + Error: The 'include_subdirs' stanza cannot appear more than once + [1] diff --git a/test/blackbox-tests/test-cases/multi-dir/test1/dune b/test/blackbox-tests/test-cases/multi-dir/test1/dune new file mode 100644 index 00000000..e5d9dd24 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test1/dune @@ -0,0 +1,3 @@ +(alias + (name default) + (action (run src/foo.exe))) diff --git a/test/blackbox-tests/test-cases/multi-dir/test1/dune-project b/test/blackbox-tests/test-cases/multi-dir/test1/dune-project new file mode 100644 index 00000000..7655de07 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test1/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) diff --git a/test/blackbox-tests/test-cases/multi-dir/test1/src/a/b/y.ml b/test/blackbox-tests/test-cases/multi-dir/test1/src/a/b/y.ml new file mode 100644 index 00000000..a4c90a73 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test1/src/a/b/y.ml @@ -0,0 +1 @@ +let x = "Hello, " diff --git a/test/blackbox-tests/test-cases/multi-dir/test1/src/c/z.ml b/test/blackbox-tests/test-cases/multi-dir/test1/src/c/z.ml new file mode 100644 index 00000000..771e86ed --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test1/src/c/z.ml @@ -0,0 +1 @@ +let x = "world!" diff --git a/test/blackbox-tests/test-cases/multi-dir/test1/src/dune b/test/blackbox-tests/test-cases/multi-dir/test1/src/dune new file mode 100644 index 00000000..d5bf89c9 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test1/src/dune @@ -0,0 +1,2 @@ +(executable (name foo)) +(include_subdirs unqualified) diff --git a/test/blackbox-tests/test-cases/multi-dir/test1/src/foo.ml b/test/blackbox-tests/test-cases/multi-dir/test1/src/foo.ml new file mode 100644 index 00000000..5e73bbc6 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test1/src/foo.ml @@ -0,0 +1 @@ +let () = prerr_endline X.x diff --git a/test/blackbox-tests/test-cases/multi-dir/test1/src/x.ml b/test/blackbox-tests/test-cases/multi-dir/test1/src/x.ml new file mode 100644 index 00000000..7a2534ea --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test1/src/x.ml @@ -0,0 +1 @@ +let x = Y.x ^ Z.x diff --git a/test/blackbox-tests/test-cases/multi-dir/test2/dune b/test/blackbox-tests/test-cases/multi-dir/test2/dune new file mode 100644 index 00000000..c2b3ee99 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test2/dune @@ -0,0 +1,7 @@ +(executable + (name main) + (libraries foo)) + +(alias + (name default) + (action (run ./main.exe))) diff --git a/test/blackbox-tests/test-cases/multi-dir/test2/dune-project b/test/blackbox-tests/test-cases/multi-dir/test2/dune-project new file mode 100644 index 00000000..7655de07 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test2/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) diff --git a/test/blackbox-tests/test-cases/multi-dir/test2/main.ml b/test/blackbox-tests/test-cases/multi-dir/test2/main.ml new file mode 100644 index 00000000..81049371 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test2/main.ml @@ -0,0 +1 @@ +let () = print_endline Foo.x diff --git a/test/blackbox-tests/test-cases/multi-dir/test2/src/a/blah.ml b/test/blackbox-tests/test-cases/multi-dir/test2/src/a/blah.ml new file mode 100644 index 00000000..771e86ed --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test2/src/a/blah.ml @@ -0,0 +1 @@ +let x = "world!" diff --git a/test/blackbox-tests/test-cases/multi-dir/test2/src/dune b/test/blackbox-tests/test-cases/multi-dir/test2/src/dune new file mode 100644 index 00000000..b123972f --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test2/src/dune @@ -0,0 +1,5 @@ +(library (name foo)) + +(rule (with-stdout-to generated.ml (run gen/gen.exe))) + +(include_subdirs unqualified) diff --git a/test/blackbox-tests/test-cases/multi-dir/test2/src/foo.ml b/test/blackbox-tests/test-cases/multi-dir/test2/src/foo.ml new file mode 100644 index 00000000..8e87e021 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test2/src/foo.ml @@ -0,0 +1 @@ +let x = Generated.x ^ Blah.x diff --git a/test/blackbox-tests/test-cases/multi-dir/test2/src/gen/dune b/test/blackbox-tests/test-cases/multi-dir/test2/src/gen/dune new file mode 100644 index 00000000..2ad1305d --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test2/src/gen/dune @@ -0,0 +1 @@ +(executable (name gen)) diff --git a/test/blackbox-tests/test-cases/multi-dir/test2/src/gen/gen.ml b/test/blackbox-tests/test-cases/multi-dir/test2/src/gen/gen.ml new file mode 100644 index 00000000..d989a7ae --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test2/src/gen/gen.ml @@ -0,0 +1 @@ +let x = print_endline {|let x = "Hello, "|} diff --git a/test/blackbox-tests/test-cases/multi-dir/test3/dune b/test/blackbox-tests/test-cases/multi-dir/test3/dune new file mode 100644 index 00000000..f3514337 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test3/dune @@ -0,0 +1,11 @@ +(test + (name main) + (libraries foo) + (modules main)) + +(library + (name foo) + (modules foo) + (c_names stub1 sub/stub2)) + +(include_subdirs unqualified) diff --git a/test/blackbox-tests/test-cases/multi-dir/test3/dune-project b/test/blackbox-tests/test-cases/multi-dir/test3/dune-project new file mode 100644 index 00000000..7655de07 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test3/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) diff --git a/test/blackbox-tests/test-cases/multi-dir/test3/foo.ml b/test/blackbox-tests/test-cases/multi-dir/test3/foo.ml new file mode 100644 index 00000000..672bca21 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test3/foo.ml @@ -0,0 +1,2 @@ +external x : unit -> string = "dune_test_x" +external y : unit -> string = "dune_test_y" diff --git a/test/blackbox-tests/test-cases/multi-dir/test3/include/dune_test.h b/test/blackbox-tests/test-cases/multi-dir/test3/include/dune_test.h new file mode 100644 index 00000000..77d9a69b --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test3/include/dune_test.h @@ -0,0 +1,2 @@ +#include +#include diff --git a/test/blackbox-tests/test-cases/multi-dir/test3/main.ml b/test/blackbox-tests/test-cases/multi-dir/test3/main.ml new file mode 100644 index 00000000..8167686e --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test3/main.ml @@ -0,0 +1 @@ +let () = print_endline (Foo.x () ^ Foo.y ()) diff --git a/test/blackbox-tests/test-cases/multi-dir/test3/stub1.c b/test/blackbox-tests/test-cases/multi-dir/test3/stub1.c new file mode 100644 index 00000000..3d311a61 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test3/stub1.c @@ -0,0 +1,6 @@ +#include "include/dune_test.h" + +CAMLprim value dune_test_x() +{ + return caml_copy_string("Hello,"); +} diff --git a/test/blackbox-tests/test-cases/multi-dir/test3/sub/stub2.c b/test/blackbox-tests/test-cases/multi-dir/test3/sub/stub2.c new file mode 100644 index 00000000..c43dc69f --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/test3/sub/stub2.c @@ -0,0 +1,6 @@ +#include "../include/dune_test.h" + +CAMLprim value dune_test_y() +{ + return caml_copy_string(" world!"); +}