From 5f25b73757c74fde044315e9b82aa70da8fcfbc0 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Fri, 17 Apr 2020 19:49:25 +0100
Subject: [PATCH] Detect dependency cycles earlier and print a better error.

This has a noticable negative effect on performance so we should
revisit the algorithm when we have the time.
---
 src/deps.ml              | 29 ++++++++++++++++++++++-------
 tests/20-circular-dep.gl | 25 +++++++++++++++++++++++++
 tests/20-circular-dep.sh | 27 +++++++++++++++++++++++++++
 3 files changed, 74 insertions(+), 7 deletions(-)
 create mode 100644 tests/20-circular-dep.gl
 create mode 100755 tests/20-circular-dep.sh

diff --git a/src/deps.ml b/src/deps.ml
index 0795cf8..1911499 100644
--- a/src/deps.ml
+++ b/src/deps.ml
@@ -30,6 +30,10 @@ let string_of_node = function
   | Goal (_, _, _, _, _, _, debug_goal) -> debug_goal
   | Exists (_, _, _, debug_pred) -> debug_pred
 
+let loc_of_node = function
+  | Goal (_, loc, _, _, _, _, _)
+  | Exists (_, loc, _, _) -> loc
+
 let compare_nodes n1 n2 =
   match n1, n2 with
   | Goal _, Exists _ -> -1
@@ -45,6 +49,8 @@ module G = Map.Make (
   end
 )
 
+exception Cycle_found
+
 type dag = {
   (* List of nodes. *)
   nodes : node list;
@@ -78,7 +84,18 @@ and add_node { nodes; edges } ?parent data =
        let children = try G.find parent edges with Not_found -> [] in
        if List.mem node children then edges
        else G.add parent (node :: children) edges in
-  node, { nodes; edges }
+  (* Doing this checks if we have added a cycle.  There may be
+   * cheaper ways to do this, see:
+   * https://stackoverflow.com/questions/20246417/how-to-detect-if-adding-an-edge-to-a-directed-graph-results-in-a-cycle
+   *)
+  let dag = { nodes; edges } in
+  (try ignore (topological_sort dag)
+   with Cycle_found ->
+     let loc = loc_of_node data in
+     failwithf "%a: adding %s creates a dependency cycle"
+       Ast.string_loc loc (string_of_node data)
+  );
+  node, dag
 
 (* This is Khan's algorithm. *)
 and topological_sort dag =
@@ -108,11 +125,7 @@ and topological_sort dag =
   in
   let dag, acc = loop dag [] incoming_map q in
 
-  if not (G.is_empty dag.edges) then
-    (* XXX More debugging to help out users!  I believe the remaining
-     * edges should demonstrate the cycle.
-     *)
-    failwithf "dependency graph contains cycles";
+  if not (G.is_empty dag.edges) then raise Cycle_found;
 
   (* This builds the topological list in reverse order, but that's
    * fine because that is the running order.
@@ -172,7 +185,9 @@ let rec create env roots =
    * is a good idea, so this function will fail if any cycle is
    * found.  We may wish to revisit this decision in future.
    *)
-  let sorted = topological_sort dag in
+  let sorted =
+    try topological_sort dag
+    with Cycle_found -> failwithf "dependency graph contains cycles" in
   if Cmdline.debug_flag () then
     eprintf "dependency order:\n  %s\n"
       (String.concat " <- " (List.map string_of_node sorted));
diff --git a/tests/20-circular-dep.gl b/tests/20-circular-dep.gl
new file mode 100644
index 0000000..556464f
--- /dev/null
+++ b/tests/20-circular-dep.gl
@@ -0,0 +1,25 @@
+# Goals test.
+# Copyright (C) 2020 Richard W.M. Jones
+# Copyright (C) 2020 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+# Circular dependency should not cause goals to crash.
+
+goal all = : dep1
+
+goal dep1 = : dep2
+
+goal dep2 = : dep1
diff --git a/tests/20-circular-dep.sh b/tests/20-circular-dep.sh
new file mode 100755
index 0000000..46294c7
--- /dev/null
+++ b/tests/20-circular-dep.sh
@@ -0,0 +1,27 @@
+#!/usr/bin/env bash
+# Goals test.
+# Copyright (C) 2020 Richard W.M. Jones
+# Copyright (C) 2020 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+# We expect this to fail.  It should exit with code 1 and
+# an error.
+goals -f 20-circular-dep.gl -d
+code=$?
+if [ $code -ne 1 ]; then
+    echo "unexpected error code: $code != 1"
+    exit 1
+fi
-- 
1.8.3.1