check alias and dependency cycles

CHANGES.md

@@ -1,6 +1,9 @@
 3.4.0 (Unreleased)
 ------------------
 
+- Building the `@check` alias should make sure the libraries and executables
+  don't have dependency cycles (#5892, @rgrinberg)
+
 - [ctypes] Add support for the `errno` parameter using the `errno_policy` field
   in the ctypes settings. (#5827, @droyo)
 

src/dune_rules/check_rules.ml

@@ -28,3 +28,9 @@ let add_files sctx ~dir files =
     let files = Path.Set.of_list files in
     Rules.Produce.Alias.add_deps alias (Action_builder.path_set files)
   else Memo.return ()
+
+let add_cycle_check sctx ~dir modules =
+  if (Super_context.context sctx).merlin then
+    let alias = Alias.check ~dir in
+    Rules.Produce.Alias.add_deps alias (Action_builder.ignore modules)
+  else Memo.return ()

src/dune_rules/check_rules.mli

@@ -5,3 +5,9 @@ val add_obj_dir :
 
 val add_files :
   Super_context.t -> dir:Path.Build.t -> Path.t list -> unit Memo.t
+
+val add_cycle_check :
+     Super_context.t
+  -> dir:Path.Build.t
+  -> Module.t list Action_builder.t
+  -> unit Memo.t

src/dune_rules/cinaps.ml

@@ -114,7 +114,7 @@ let gen_rules sctx t ~dir ~scope =
       ~flags:(Ocaml_flags.of_list [ "-w"; "-24" ])
       ~js_of_ocaml:None ~package:None
   in
-  let* () =
+  let* (_ : Exe.dep_graphs) =
     Exe.build_and_link cctx
       ~program:{ name; main_module_name; loc }
       ~linkages:[ Exe.Linkage.native_or_custom (Super_context.context sctx) ]

src/dune_rules/ctypes_rules.ml

@@ -455,7 +455,7 @@ let gen_rules ~cctx ~(buildable : Buildable.t) ~loc ~scope ~dir ~sctx =
         write_discover_script ~sctx ~dir ~filename:(discover_script ^ ".ml")
           ~cflags_sexp ~c_library_flags_sexp ~external_library_name
       in
-      let* () =
+      let* (_ : Exe.dep_graphs) =
         exe_build_and_link ~scope ~loc ~dir ~cctx ~sandbox
           ~libraries:[ "dune.configurator" ] discover_script
       in
@@ -487,7 +487,7 @@ let gen_rules ~cctx ~(buildable : Buildable.t) ~loc ~scope ~dir ~sctx =
       write_type_gen_script ~headers ~sctx ~dir
         ~filename:(type_gen_script ^ ".ml") ~type_description_functor
     in
-    let* () = exe_link_only type_gen_script in
+    let* (_ : Exe.dep_graphs) = exe_link_only type_gen_script in
     let* () =
       rule ~stdout_to:c_generated_types_cout_c ~exe:(type_gen_script ^ ".exe")
         ()
@@ -525,7 +525,7 @@ let gen_rules ~cctx ~(buildable : Buildable.t) ~loc ~scope ~dir ~sctx =
             ~errno_policy:fd.errno_policy
             ~function_description_functor:fd.functor_
         in
-        let* () = exe_link_only function_gen_script in
+        let* (_ : Exe.dep_graphs) = exe_link_only function_gen_script in
         let* () =
           rule ~stdout_to:c_generated_functions_cout_c
             ~exe:(function_gen_script ^ ".exe")

src/dune_rules/exe.ml

@@ -224,39 +224,48 @@ let link_js ~name ~loc ~cm_files ~promote ~link_time_code_gen cctx =
   Jsoo_rules.build_exe cctx ~loc ~in_context ~src ~cm:top_sorted_cms ~promote
     ~link_time_code_gen:other_cm
 
+type dep_graphs = { for_exes : Module.t list Action_builder.t list }
+
 let link_many ?link_args ?o_files ?(embed_in_plugin_libraries = []) ?sandbox
     ~programs ~linkages ~promote cctx =
   let open Memo.O in
   let modules = Compilation_context.modules cctx in
   let* link_time_code_gen = Link_time_code_gen.handle_special_libs cctx in
-  Memo.parallel_iter programs ~f:(fun { Program.name; main_module_name; loc } ->
-      let cm_files =
-        let sctx = CC.super_context cctx in
-        let ctx = SC.context sctx in
-        let obj_dir = CC.obj_dir cctx in
+  let+ for_exes =
+    Memo.parallel_map programs
+      ~f:(fun { Program.name; main_module_name; loc } ->
         let top_sorted_modules =
           let main = Option.value_exn (Modules.find modules main_module_name) in
           Dep_graph.top_closed_implementations (CC.dep_graphs cctx).impl
             [ main ]
         in
-        Cm_files.make ~obj_dir ~modules ~top_sorted_modules
-          ~ext_obj:ctx.lib_config.ext_obj ()
-      in
-      Memo.parallel_iter linkages ~f:(fun linkage ->
-          if Linkage.is_js linkage then
-            link_js ~loc ~name ~cm_files ~promote cctx ~link_time_code_gen
-          else
-            let* link_time_code_gen =
-              match Linkage.is_plugin linkage with
-              | false -> Memo.return link_time_code_gen
-              | true ->
-                let cc =
-                  CC.for_plugin_executable cctx ~embed_in_plugin_libraries
+        let cm_files =
+          let sctx = CC.super_context cctx in
+          let ctx = SC.context sctx in
+          let obj_dir = CC.obj_dir cctx in
+          Cm_files.make ~obj_dir ~modules ~top_sorted_modules
+            ~ext_obj:ctx.lib_config.ext_obj ()
+        in
+        let+ () =
+          Memo.parallel_iter linkages ~f:(fun linkage ->
+              if Linkage.is_js linkage then
+                link_js ~loc ~name ~cm_files ~promote cctx ~link_time_code_gen
+              else
+                let* link_time_code_gen =
+                  match Linkage.is_plugin linkage with
+                  | false -> Memo.return link_time_code_gen
+                  | true ->
+                    let cc =
+                      CC.for_plugin_executable cctx ~embed_in_plugin_libraries
+                    in
+                    Link_time_code_gen.handle_special_libs cc
                 in
-                Link_time_code_gen.handle_special_libs cc
-            in
-            link_exe cctx ~loc ~name ~linkage ~cm_files ~link_time_code_gen
-              ~promote ?link_args ?o_files ?sandbox))
+                link_exe cctx ~loc ~name ~linkage ~cm_files ~link_time_code_gen
+                  ~promote ?link_args ?o_files ?sandbox)
+        in
+        top_sorted_modules)
+  in
+  { for_exes }
 
 let build_and_link_many ?link_args ?o_files ?embed_in_plugin_libraries ?sandbox
     ~programs ~linkages ~promote cctx =

src/dune_rules/exe.mli

@@ -40,6 +40,8 @@ module Linkage : sig
     Context.t -> loc:Loc.t -> Dune_file.Executables.Link_mode.t -> t
 end
 
+type dep_graphs = { for_exes : Module.t list Action_builder.t list }
+
 (** {1 High-level functions} *)
 
 (** Build and link one or more executables *)
@@ -55,7 +57,7 @@ val link_many :
   -> linkages:Linkage.t list
   -> promote:Rule.Promote.t option
   -> Compilation_context.t
-  -> unit Memo.t
+  -> dep_graphs Memo.t
 
 val build_and_link :
      ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t
@@ -66,7 +68,7 @@ val build_and_link :
   -> linkages:Linkage.t list
   -> promote:Rule.Promote.t option
   -> Compilation_context.t
-  -> unit Memo.t
+  -> dep_graphs Memo.t
 
 val build_and_link_many :
      ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t
@@ -77,7 +79,7 @@ val build_and_link_many :
   -> linkages:Linkage.t list
   -> promote:Rule.Promote.t option
   -> Compilation_context.t
-  -> unit Memo.t
+  -> dep_graphs Memo.t
 
 val exe_path :
      Compilation_context.t

src/dune_rules/exe_rules.ml

@@ -156,7 +156,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
          ~instrumentation_backend:
            (Lib.DB.instrumentation_backend (Scope.libs scope)))
   in
-  let+ () =
+  let* dep_graphs =
     (* Building an archive for foreign stubs, we link the corresponding object
        files directly to improve perf. *)
     let link_deps, sandbox = Dep_conf_eval.unnamed ~expander exes.link_deps in
@@ -204,8 +204,8 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
         ~requires_compile
     in
     let* () = Check_rules.add_files sctx ~dir o_files in
-    let buildable = exes.Executables.buildable in
-    match buildable.Buildable.ctypes with
+    let buildable = exes.buildable in
+    match buildable.ctypes with
     | None ->
       Exe.build_and_link_many cctx ~programs ~linkages ~link_args ~o_files
         ~promote:exes.promote ~embed_in_plugin_libraries ~sandbox
@@ -223,6 +223,10 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
       Exe.link_many ~programs ~linkages ~link_args ~o_files
         ~promote:exes.promote ~embed_in_plugin_libraries cctx ~sandbox
   in
+  let+ () =
+    Memo.parallel_iter dep_graphs.for_exes
+      ~f:(Check_rules.add_cycle_check sctx ~dir)
+  in
   ( cctx
   , Merlin.make ~requires:requires_compile ~stdlib_dir ~flags ~modules
       ~preprocess ~obj_dir

src/dune_rules/inline_tests.ml

@@ -170,7 +170,7 @@ include Sub_system.Register_end_point (struct
           | Byte -> Exe.Linkage.byte
           | Javascript -> Exe.Linkage.js)
     in
-    let* () =
+    let* (_ : Exe.dep_graphs) =
       let link_args =
         let open Action_builder.O in
         let+ link_args_info =

src/dune_rules/lib_rules.ml

@@ -300,7 +300,8 @@ let build_shared lib ~native_archives ~sctx ~dir ~flags =
       in
       Super_context.add_rule sctx build ~dir ~loc:lib.buildable.loc)
 
-let setup_build_archives (lib : Dune_file.Library.t) ~cctx ~expander ~scope =
+let setup_build_archives (lib : Dune_file.Library.t) ~top_sorted_modules ~cctx
+    ~expander ~scope =
   let obj_dir = Compilation_context.obj_dir cctx in
   let dir = Compilation_context.dir cctx in
   let flags = Compilation_context.flags cctx in
@@ -311,7 +312,6 @@ let setup_build_archives (lib : Dune_file.Library.t) ~cctx ~expander ~scope =
   let sctx = Compilation_context.super_context cctx in
   let ctx = Compilation_context.context cctx in
   let { Lib_config.ext_obj; natdynlink_supported; _ } = ctx.lib_config in
-  let impl_only = Modules.impl_only modules in
   let open Memo.O in
   let* () =
     Modules.exit_module modules
@@ -336,10 +336,6 @@ let setup_build_archives (lib : Dune_file.Library.t) ~cctx ~expander ~scope =
                   Super_context.add_rule sctx ~dir ~loc:lib.buildable.loc
                     (Action_builder.copy ~src ~dst)))
   in
-  let top_sorted_modules =
-    Dep_graph.top_closed_implementations
-      (Compilation_context.dep_graphs cctx).impl impl_only
-  in
   let modes = Compilation_context.modes cctx in
   (* The [dir] below is used as an object directory without going through
      [Obj_dir]. That's fragile and will break if the layout of the object
@@ -451,18 +447,25 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents
   let scope = Compilation_context.scope cctx in
   let* requires_compile = Compilation_context.requires_compile cctx in
   let stdlib_dir = (Compilation_context.context cctx).Context.stdlib_dir in
+  let top_sorted_modules =
+    let impl_only = Modules.impl_only modules in
+    Dep_graph.top_closed_implementations
+      (Compilation_context.dep_graphs cctx).impl impl_only
+  in
   let* () =
     Memo.Option.iter vimpl
       ~f:(Virtual_rules.setup_copy_rules_for_impl ~sctx ~dir)
   in
   let* () = Check_rules.add_obj_dir sctx ~obj_dir in
+  let* () = Check_rules.add_cycle_check sctx ~dir top_sorted_modules in
   let* () = gen_wrapped_compat_modules lib cctx
   and* () = Module_compilation.build_all cctx
   and* expander = Super_context.expander sctx ~dir in
   let+ () =
     Memo.when_
       (not (Library.is_virtual lib))
-      (fun () -> setup_build_archives lib ~cctx ~expander ~scope)
+      (fun () ->
+        setup_build_archives lib ~top_sorted_modules ~cctx ~expander ~scope)
   and+ () =
     let vlib_stubs_o_files = Vimpl.vlib_stubs_o_files vimpl in
     Memo.when_

src/dune_rules/mdx.ml

@@ -394,7 +394,7 @@ let mdx_prog_gen t ~sctx ~dir ~scope ~expander ~mdx_prog =
       ~modules ~flags ~requires_compile ~requires_link ~opaque:(Explicit false)
       ~js_of_ocaml:None ~package:None ()
   in
-  let+ () =
+  let+ (_ : Exe.dep_graphs) =
     Exe.build_and_link cctx
       ~program:{ name; main_module_name; loc }
       ~link_args:(Action_builder.return (Command.Args.A "-linkall"))

src/dune_rules/preprocessing.ml

@@ -332,7 +332,10 @@ let build_ppx_driver sctx ~scope ~target ~pps ~pp_names =
       ~requires_compile:(Memo.return requires_compile)
       ~requires_link ~opaque ~js_of_ocaml:None ~package:None ~bin_annot:false ()
   in
-  Exe.build_and_link ~program ~linkages cctx ~promote:None
+  let+ (_ : Exe.dep_graphs) =
+    Exe.build_and_link ~program ~linkages cctx ~promote:None
+  in
+  ()
 
 let get_rules sctx key =
   let exe = ppx_exe sctx ~key in

src/dune_rules/toplevel.ml

@@ -112,7 +112,7 @@ let setup_rules_and_return_exe_path t =
   let open Memo.O in
   let linkage = Exe.Linkage.custom (Compilation_context.context t.cctx) in
   let program = Source.program t.source in
-  let* () =
+  let* (_ : Exe.dep_graphs) =
     Exe.build_and_link t.cctx ~program ~linkages:[ linkage ]
       ~link_args:
         (Action_builder.return

test/blackbox-tests/test-cases/check-alias/ocamldep-cycles.t

@@ -0,0 +1,37 @@
+The @check alias should detect dependency cycles
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.2)
+  > EOF
+
+  $ cat >dune <<EOF
+  > (library (name foo))
+  > EOF
+
+  $ cat >a.ml <<EOF
+  > module B = B
+  > EOF
+
+  $ touch b.ml b.mli a.mli
+
+  $ dune build @all
+
+  $ cat >b.ml <<EOF
+  > module A = A
+  > EOF
+
+  $ dune build @check
+  Error: dependency cycle between modules in _build/default:
+     B
+  -> A
+  -> B
+  -> required by alias check
+  [1]
+  $ dune build @all
+  Error: dependency cycle between modules in _build/default:
+     B
+  -> A
+  -> B
+  -> required by _build/default/foo.cma
+  -> required by alias all
+  [1]