Adapt the design of multi directory libraries

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
ocaml · Aug 5, 2018 · 0e6dda2 · 0e6dda2
1 parent d484f7b
commit 0e6dda2
Show file tree

Hide file tree

Showing 12 changed files with 112 additions and 79 deletions.
diff --git 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:
-
-- 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)``.
+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 <x>)``
+where ``<x>`` is not ``no`` to contain one of the following stanzas:
+
+- ``library``
+- ``executable(s)``
+- ``test(s)``
 
 Common items
 ============

diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -1 +1,2 @@
 (executable (name gen))
+(include_subdirs no)