From dacf832a9595116c4a3384232d785311cd1ec811 Mon Sep 17 00:00:00 2001 From: Gary King Date: Tue, 22 Mar 2011 11:46:32 -0400 Subject: [PATCH] fix for rootp from Willem Rein Oudshoorn (thank you) Note that this changes the behavior of `rootp`. If you rely on the old (broken) behavior, then this patch will break your code. Sorry. --- dev/graph.lisp | 2 +- unit-tests/test-graph.lisp | 30 +++++++++++++++++++++++++----- 2 files changed, 26 insertions(+), 6 deletions(-) diff --git a/dev/graph.lisp b/dev/graph.lisp index 96ad209..6df7ec3 100644 --- a/dev/graph.lisp +++ b/dev/graph.lisp @@ -646,7 +646,7 @@ something is putting something on the vertexes plist's (defmethod rootp ((vertex basic-vertex)) ;;?? this is inefficient in the same way that (zerop (length )) is... - (zerop (source-edge-count vertex))) + (zerop (target-edge-count vertex))) (defmethod find-vertex-if ((graph basic-graph) fn &key key) diff --git a/unit-tests/test-graph.lisp b/unit-tests/test-graph.lisp index 1a64abc..c55ee29 100644 --- a/unit-tests/test-graph.lisp +++ b/unit-tests/test-graph.lisp @@ -154,8 +154,6 @@ a - b - e (deftestsuite test-change-vertex-value (test-basic-graph-properties) ()) -;;; --------------------------------------------------------------------------- - (addtest (test-change-vertex-value) test-undirected (let ((b (find-vertex graph-undirected 'b))) @@ -166,9 +164,31 @@ a - b - e (ensure (find-edge-between-vertexes graph-undirected 'a 'x)) (ensure (find-edge-between-vertexes graph-undirected 'x 'd)))) +;;; +(deftestsuite test-rootp (cl-graph-test) + ((g (make-container 'graph-container + :default-edge-type :directed))) + (:setup + (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do + (add-edge-between-vertexes g v1 v2)))) -;;; --------------------------------------------------------------------------- -;;; test-replace-edge -;;; --------------------------------------------------------------------------- +(addtest (test-rootp) + directed-edges + (ensure (directed-edge-p (first-item (graph-edges g))))) + +(addtest(test-rootp) + test-source-vertex + (ensure (rootp (find-vertex g 'a)))) +(addtest(test-rootp) + test-sink-vertex + (ensure-null (rootp (find-vertex g 'e)))) + +(addtest(test-rootp) + test-middle-vertex + (ensure-null (rootp (find-vertex g 'b)))) + + + + -- 1.7.10.4