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.

diff --git a/dev/graph.lisp b/dev/graph.lisp
index 96ad209..6df7ec3 100644 (file)
--- 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 <list>)) 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 (file)
--- 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))))
+
+
+  
+