| 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
end
)
+exception Cycle_found
+
type dag = {
(* List of nodes. *)
nodes : node list;
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 =
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.
* 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));
--- /dev/null
+# 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
--- /dev/null
+#!/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