Fix non-singleton executables missing from dot output

src/depgraph/common.ml

@@ -14,8 +14,11 @@ let show_package = function
 
 module V =
 struct
+  type executable_cluster = string list [@@deriving eq, ord]
+
   type executable = {
     package: package option;
+    cluster: executable_cluster;
     name: string;
   }
   [@@deriving eq, ord]
@@ -29,6 +32,7 @@ struct
   [@@deriving eq, ord]
 
   type t =
+    | ExecutableCluster of executable_cluster (** Only for module parent, not used in dot output. *)
     | Executable of executable
     | Library of library
     | Module of {parent: t; name: string}

src/depgraph/dot_graph.ml

@@ -22,6 +22,8 @@ struct
       [`Shape `Box]
     | SysPackage _ ->
       [`Shape `Box; `Style `Filled]
+    | ExecutableCluster _ ->
+      assert false
   let default_vertex_attributes _ = []
   let default_edge_attributes _ = []
   let rec vertex_name = function
@@ -31,11 +33,15 @@ struct
     | LocalPackageCluster -> "local_package__"
     | OpamPackage package -> Opkg.Name.to_string package.name ^ "\n" ^ Opkg.Version.to_string package.version
     | SysPackage name -> name
+    | ExecutableCluster names -> String.concat ", " names
   let local_package_subgraph = string_of_int (Hashtbl.hash (show_package Local))
   let get_subgraph = function
     | VV.Module {parent; _} ->
       Some {Ocamlgraph_extra.Graphviz.DotAttributes.sg_name = string_of_int (V.hash parent); sg_attributes = [`Label (vertex_name parent)]; sg_parent = Some local_package_subgraph}
-    | (Library {local = true; _} | Executable _) as v ->
+    | Library {local = true; _} as v ->
+      Some {Ocamlgraph_extra.Graphviz.DotAttributes.sg_name = string_of_int (V.hash v); sg_attributes = [`Label (vertex_name v)]; sg_parent = Some local_package_subgraph}
+    | Executable {cluster; _} ->
+      let v = VV.ExecutableCluster cluster in
       Some {Ocamlgraph_extra.Graphviz.DotAttributes.sg_name = string_of_int (V.hash v); sg_attributes = [`Label (vertex_name v)]; sg_parent = Some local_package_subgraph}
     | Library {local = false; package; _} ->
       begin match package with
@@ -48,6 +54,8 @@ struct
     | OpamPackage _
     | SysPackage _ ->
       None
+    | ExecutableCluster _ ->
+      assert false
   let vertex_name v = Printf.sprintf "\"%s\"" (vertex_name v)
   let edge_attributes (u, e, v) =
     let label =

src/depgraph/dune_describe_graph.ml

@@ -70,8 +70,8 @@ let g_of_library_modules ~tred_modules library modules =
   else
     g
 
-let g_of_executable_modules ~tred_modules executable modules =
-  let parent: V.t = Executable executable in
+let g_of_executable_modules ~tred_modules executable_cluster modules =
+  let parent: V.t = ExecutableCluster executable_cluster in
   let g = g_of_modules parent modules in
   let g = G.remove_vertex g (Module {parent; name = "Dune__exe"}) in
   if tred_modules then
@@ -94,7 +94,7 @@ let g_of_libraries ~tred_libraries dune_describe =
       | Executables {names; requires; _} ->
         let package = Some Local in
         List.fold_left (fun g name ->
-            let exe: V.t = Executable {package; name} in
+            let exe: V.t = Executable {package; cluster = names; name} in
             let g = G.add_vertex g exe in
             List.fold_left (fun g require ->
                 G.add_edge g exe (Library (Digest_map.find require digest_map))
@@ -136,14 +136,14 @@ let g_of_string ~tred_modules ~tred_libraries s =
           g
       | Executables {names; modules; _} ->
         let package = Some Local in
-        let name = String.concat ", " names in
-        let executable: V.executable = {package; name} in
-        let g = GOper.union g (g_of_executable_modules ~tred_modules executable modules) in
+        let executable_cluster = names in
+        let g = GOper.union g (g_of_executable_modules ~tred_modules executable_cluster modules) in
         (* executable-module edges *)
+        let parent: V.t = ExecutableCluster executable_cluster in
         List.fold_left (fun g name ->
-            let parent: V.t = Executable {package; name} in
+            let executable: V.t = Executable {package; cluster = executable_cluster; name} in
             let executable_module_name = String.capitalize_ascii name in
-            G.add_edge g parent (Module {parent; name = executable_module_name})
+            G.add_edge g executable (Module {parent; name = executable_module_name})
           ) g names
       | _ ->
         g