From: Gary King <gwking@metabang.com>
Date: Fri, 12 Sep 2008 02:03:47 +0000 (-0400)
Subject: Fix for case 218: 'child-vertexes and parent-vertexes swapped'
X-Git-Url: http://repo.macrolet.net/gitweb/?p=cl-graph.git;a=commitdiff_plain;h=30d6c8f9bd55ddefd48d333bfeb73b1a2a333e99

Fix for case 218: 'child-vertexes and parent-vertexes swapped'

darcs-hash:20080912020347-3cc5d-97ed0862a7591d58500f6796c27f6bf5f2bf8965.gz
---

diff --git a/dev/graph-container.lisp b/dev/graph-container.lisp
index 91fde47..21ca52e 100644
--- a/dev/graph-container.lisp
+++ b/dev/graph-container.lisp
@@ -283,14 +283,14 @@ DISCUSSION
 ;;; ---------------------------------------------------------------------------
 
 (defmethod iterate-children ((vertex graph-container-vertex) fn)
-  (iterate-target-edges vertex
+  (iterate-source-edges vertex
                         (lambda (edge)
                           (funcall fn (other-vertex edge vertex)))))
 
 ;;; ---------------------------------------------------------------------------
 
 (defmethod iterate-parents ((vertex graph-container-vertex) fn)
-  (iterate-source-edges vertex
+  (iterate-target-edges vertex
                         (lambda (edge)
                           (funcall fn (other-vertex edge vertex)))))
 
diff --git a/unit-tests/test-api.lisp b/unit-tests/test-api.lisp
index c712543..e1d4206 100644
--- a/unit-tests/test-api.lisp
+++ b/unit-tests/test-api.lisp
@@ -37,3 +37,35 @@
 		     (eq b (target-vertex edge)))
 		   target-edges) :report "targets")))
     
+(addtest (test-api
+	  :documentation "case 218")
+  parents-of-child-vertexes
+  (let* ((g (build-single-diamond-graph :directed))
+	 (b (find-vertex g 'b))
+	 (child-vertexes (child-vertexes b)))
+    (ensure (every (lambda (vertex)
+		     (member b (parent-vertexes vertex)))
+		   child-vertexes) :report "children")))
+
+(addtest (test-api
+	  :documentation "case 218")
+  children-of-parent-vertexes
+  (let* ((g (build-single-diamond-graph :directed))
+	 (b (find-vertex g 'b))
+	 (parent-vertexes (parent-vertexes b)))
+    (ensure (every (lambda (vertex)
+		     (member b (child-vertexes vertex)))
+		   parent-vertexes) :report "parents")))
+
+(addtest (test-api
+	  :documentation "case 218")
+  parents-and-children=are-correct
+  (let* ((g (build-single-diamond-graph :directed))
+	 (b (find-vertex g 'b))
+	 (child-vertexes (child-vertexes b))
+	 (parent-vertexes (parent-vertexes b)))
+    (ensure-same child-vertexes (list (find-vertex g 'c)
+				      (find-vertex g 'i))
+		 :test 'set-equal))
+    (ensure-same parent-vertexes (list (find-vertex g 'a))
+		 :test 'set-equal))