From 30d6c8f9bd55ddefd48d333bfeb73b1a2a333e99 Mon Sep 17 00:00:00 2001 From: Gary King Date: Thu, 11 Sep 2008 22:03:47 -0400 Subject: [PATCH] Fix for case 218: 'child-vertexes and parent-vertexes swapped' darcs-hash:20080912020347-3cc5d-97ed0862a7591d58500f6796c27f6bf5f2bf8965.gz --- dev/graph-container.lisp | 4 ++-- unit-tests/test-api.lisp | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+), 2 deletions(-) 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)) -- 1.7.10.4