From: Richard W.M. Jones Date: Fri, 4 Feb 2022 11:09:18 +0000 (+0000) Subject: deps: Try to print the dependency cycle in error message X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=869f9408d714a875a7c35b98ad471a15caea8197;p=goals.git deps: Try to print the dependency cycle in error message Instead of: *** error: function:wrap:6:0: adding fedora-rebuild ("ocaml-odoc") creates a dependency cycle it now prints: *** error: function:wrap:4:0: dependency cycle: fedora-rebuild ("ocaml-odoc") -> fedora-rebuild ("ocaml-mdx") -> fedora-rebuild ("ocaml-odoc-parser") -> fedora-rebuild ("ocaml-ppx-expect") -> fedora-rebuild ("ocaml-ppx-inline-test") -> fedora-rebuild ("ocaml-time-now") -> fedora-rebuild ("ocaml-ppx-base") -> fedora-rebuild ("ocaml-ppx-js-style") -> fedora-rebuild ("ocaml-octavius") -> fedora-rebuild ("ocaml-odoc") --- diff --git a/src/deps.ml b/src/deps.ml index c1c1474..088c64d 100644 --- a/src/deps.ml +++ b/src/deps.ml @@ -88,21 +88,33 @@ and add_node { nodes; edges } ?parent data = * ensure we don't make a cycle, check there is no path * already from node -> parent. *) - if exists_path node parent edges then ( - let loc = loc_of_node data in - failwithf "%a: adding %s creates a dependency cycle" - Ast.string_loc loc (string_of_node data) + (match exists_path node parent edges with + | None -> () + | Some nodes -> + let loc = loc_of_node data in + failwithf "%a: dependency cycle: %s -> %s" + Ast.string_loc loc + (String.concat " -> " (List.map string_of_node nodes)) + (string_of_node data) ); G.add parent (node :: children) edges ) in node, { nodes; edges } -(* Is there a path from n1 to n2 in edges? *) +(* Is there a path from n1 to n2 in edges? + * Returns [None] if no path, or [Some nodes] if there is a path. + *) and exists_path n1 n2 edges = - if compare_nodes n1 n2 = 0 then true + if compare_nodes n1 n2 = 0 then Some [n2] else ( let children = try G.find n1 edges with Not_found -> [] in - List.exists (fun n -> exists_path n n2 edges) children + let path = + List.find_map ( + fun n -> exists_path n n2 edges + ) children in + match path with + | None -> None + | Some nodes -> Some (n1 :: nodes) ) (* This is Khan's algorithm. *)