From 0e6dda20327b731b8b86ee127d79d805d0b24b6d Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 2 Aug 2018 10:58:45 +0100 Subject: [PATCH] Adapt the design of multi directory libraries Signed-off-by: Jeremie Dimino --- doc/dune-files.rst | 12 +- src/dir_contents.ml | 147 +++++++++--------- .../test-cases/multi-dir/error3/dune | 7 + .../test-cases/multi-dir/error3/dune-project | 1 + .../test-cases/multi-dir/error3/main.ml | 1 + .../test-cases/multi-dir/error3/src/a/blah.ml | 1 + .../test-cases/multi-dir/error3/src/dune | 5 + .../test-cases/multi-dir/error3/src/foo.ml | 1 + .../test-cases/multi-dir/error3/src/gen/dune | 1 + .../multi-dir/error3/src/gen/gen.ml | 1 + .../blackbox-tests/test-cases/multi-dir/run.t | 11 +- .../test-cases/multi-dir/test2/src/gen/dune | 1 + 12 files changed, 111 insertions(+), 78 deletions(-) create mode 100644 test/blackbox-tests/test-cases/multi-dir/error3/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/error3/dune-project create mode 100644 test/blackbox-tests/test-cases/multi-dir/error3/main.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/error3/src/a/blah.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/error3/src/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/error3/src/foo.ml create mode 100644 test/blackbox-tests/test-cases/multi-dir/error3/src/gen/dune create mode 100644 test/blackbox-tests/test-cases/multi-dir/error3/src/gen/gen.ml diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 4be81c08..3c2915ee 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -822,12 +822,14 @@ 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: +recursion will stop when encountering a sub-directory that contains +another ``include_subdirs`` stanza. Additionally, it is not allowed +for a sub-directory of a directory with ``(include_subdirs )`` +where ```` is not ``no`` to contain one of the following stanzas: -- 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)``. +- ``library`` +- ``executable(s)`` +- ``test(s)`` Common items ============ diff --git a/src/dir_contents.ml b/src/dir_contents.ml index e380f60a..470f30b7 100644 --- a/src/dir_contents.ml +++ b/src/dir_contents.ml @@ -486,44 +486,46 @@ let build_mlds_map (d : Super_context.Dir_with_jbuild.t) ~files = 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 *) + | Standalone of + (File_tree.Dir.t * Super_context.Dir_with_jbuild.t option) option + (* Directory not part of a multi-directory group. The argument is + [None] for directory that are not from the source tree, such as + generated ones. *) | Group_root of File_tree.Dir.t * Super_context.Dir_with_jbuild.t (* Directory with [(include_subdirs x)] where [x] is not [no] *) + | Is_component_of_a_group_but_not_the_root of + Super_context.Dir_with_jbuild.t option + (* Sub-directory of a [Group_root _] *) + let is_standalone = function - | Standalone _ | Empty_standalone _ -> true + | 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 get_include_subdirs stanzas = + List.fold_left stanzas ~init:None ~f:(fun acc stanza -> + match stanza with + | Include_subdirs (loc, x) -> + if Option.is_some acc then + Loc.fail loc "The 'include_subdirs' stanza cannot appear \ + more than once"; + Some x + | _ -> acc) + + let check_no_module_consumer stanzas = + List.iter stanzas ~f:(fun stanza -> + match stanza with + | Library { buildable; _} | Executables { buildable; _ } + | Tests { exes = { buildable; _ }; _ } -> + Loc.fail buildable.loc + "This stanza is not allowed in a sub-directory of directory with \ + (include_subdirs unqualified).\n\ + Hint: add (include_subdirs no) to this file." + | _ -> ()) let rec get sctx ~dir = match Hashtbl.find cache dir with @@ -534,29 +536,38 @@ module Dir_status = struct Option.bind (Path.drop_build_context dir) ~f:(File_tree.find_dir (Super_context.file_tree sctx)) with - | None -> Empty_standalone None + | None -> begin + match Path.parent dir with + | None -> Standalone None + | Some dir -> + if is_standalone (get sctx ~dir) then + Standalone None + else + Is_component_of_a_group_but_not_the_root None + end | 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) + Standalone (Some (ft_dir, None)) 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 + match get_include_subdirs d.stanzas with + | Some Unqualified -> 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) + | Some No -> + Standalone (Some (ft_dir, Some d)) + | None -> + if dir <> project_root && + not (is_standalone (get sctx ~dir:(Path.parent_exn dir))) + then begin + check_no_module_consumer d.stanzas; + Is_component_of_a_group_but_not_the_root (Some d) + end else + Standalone (Some (ft_dir, Some d)) in Hashtbl.add cache dir t; t @@ -569,14 +580,13 @@ module Dir_status = struct 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 + match get_include_subdirs d.stanzas with + | Some Unqualified -> Group_root (ft_dir, d) - else if has_modules_consumers then - Standalone (ft_dir, d) - else + | Some No -> + Standalone (Some (ft_dir, Some d)) + | None -> + check_no_module_consumer d.stanzas; Is_component_of_a_group_but_not_the_root (Some d) in Hashtbl.add cache dir t; @@ -590,17 +600,25 @@ let rec get sctx ~dir = | Some t -> t | None -> match Dir_status.get sctx ~dir with - | Empty_standalone ft_dir -> + | Standalone x -> 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 [] - } + match x with + | Some (ft_dir, Some d) -> + let files = load_text_files sctx ft_dir d in + { 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) + } + | _ -> + { kind = Standalone + ; dir + ; text_files = String.Set.empty + ; modules = lazy empty_modules + ; mlds = lazy [] + } in Hashtbl.add cache dir t; t @@ -612,19 +630,6 @@ let rec get sctx ~dir = (* Filled while scanning the group root *) Option.value_exn (Hashtbl.find cache dir) end - | 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 diff --git a/test/blackbox-tests/test-cases/multi-dir/error3/dune b/test/blackbox-tests/test-cases/multi-dir/error3/dune new file mode 100644 index 00000000..c2b3ee99 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error3/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/error3/dune-project b/test/blackbox-tests/test-cases/multi-dir/error3/dune-project new file mode 100644 index 00000000..7655de07 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error3/dune-project @@ -0,0 +1 @@ +(lang dune 1.1) diff --git a/test/blackbox-tests/test-cases/multi-dir/error3/main.ml b/test/blackbox-tests/test-cases/multi-dir/error3/main.ml new file mode 100644 index 00000000..81049371 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error3/main.ml @@ -0,0 +1 @@ +let () = print_endline Foo.x diff --git a/test/blackbox-tests/test-cases/multi-dir/error3/src/a/blah.ml b/test/blackbox-tests/test-cases/multi-dir/error3/src/a/blah.ml new file mode 100644 index 00000000..771e86ed --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error3/src/a/blah.ml @@ -0,0 +1 @@ +let x = "world!" diff --git a/test/blackbox-tests/test-cases/multi-dir/error3/src/dune b/test/blackbox-tests/test-cases/multi-dir/error3/src/dune new file mode 100644 index 00000000..b123972f --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error3/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/error3/src/foo.ml b/test/blackbox-tests/test-cases/multi-dir/error3/src/foo.ml new file mode 100644 index 00000000..8e87e021 --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error3/src/foo.ml @@ -0,0 +1 @@ +let x = Generated.x ^ Blah.x diff --git a/test/blackbox-tests/test-cases/multi-dir/error3/src/gen/dune b/test/blackbox-tests/test-cases/multi-dir/error3/src/gen/dune new file mode 100644 index 00000000..2ad1305d --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error3/src/gen/dune @@ -0,0 +1 @@ +(executable (name gen)) diff --git a/test/blackbox-tests/test-cases/multi-dir/error3/src/gen/gen.ml b/test/blackbox-tests/test-cases/multi-dir/error3/src/gen/gen.ml new file mode 100644 index 00000000..d989a7ae --- /dev/null +++ b/test/blackbox-tests/test-cases/multi-dir/error3/src/gen/gen.ml @@ -0,0 +1 @@ +let x = print_endline {|let x = "Hello, "|} diff --git a/test/blackbox-tests/test-cases/multi-dir/run.t b/test/blackbox-tests/test-cases/multi-dir/run.t index c3d21ea6..45f2a116 100644 --- a/test/blackbox-tests/test-cases/multi-dir/run.t +++ b/test/blackbox-tests/test-cases/multi-dir/run.t @@ -6,8 +6,8 @@ Simple test with a multi dir exe foo alias default Hello, world! -Test that executables stop the recursion ----------------------------------------- +Test that include_subdirs stop the recursion +-------------------------------------------- $ dune build --root test2 Entering directory 'test2' @@ -38,3 +38,10 @@ Test some error cases File "dune", line 2, characters 0-29: Error: The 'include_subdirs' stanza cannot appear more than once [1] + + $ dune build --root error3 + Entering directory 'error3' + File "src/gen/dune", line 1, characters 0-23: + Error: This stanza is not allowed in a sub-directory of directory with (include_subdirs unqualified). + Hint: add (include_subdirs no) to this file. + [1] 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 index 2ad1305d..30b71cf5 100644 --- a/test/blackbox-tests/test-cases/multi-dir/test2/src/gen/dune +++ b/test/blackbox-tests/test-cases/multi-dir/test2/src/gen/dune @@ -1 +1,2 @@ (executable (name gen)) +(include_subdirs no) \ No newline at end of file