fix for rootp from Willem Rein Oudshoorn (thank you)

[cl-graph.git] / unit-tests / test-graph.lisp

diff --git a/unit-tests/test-graph.lisp b/unit-tests/test-graph.lisp
index a94dd28..c55ee29 100644 (file)
--- a/unit-tests/test-graph.lisp
+++ b/unit-tests/test-graph.lisp
@@ -1,4 +1,4 @@
-(in-package metabang.graph)
+(in-package #:cl-graph-test)
 
 #|
 (let ((g (make-container 'graph-container))) 
@@ -10,24 +10,23 @@
     (inspect g)))
 |#
 
-(deftestsuite test-graph () ())
+(deftestsuite cl-graph-test () ())
 
-
-(deftestsuite test-test-vertex () ())
+(deftestsuite test-test-vertex (cl-graph-test) ())
 
 (addtest (test-test-vertex)
   test-1
-  (bind ((x (float 2.1d0))
-         (y (float 2.1d0))
-         (g (make-container 'graph-container)))
+  (let ((x (float 2.1d0))
+       (y (float 2.1d0))
+       (g (make-container 'graph-container)))
     (add-vertex g (+ x y))
     (add-vertex g (+ x y))
     
     (ensure-same (size g) 2)))
 
 (addtest (test-test-vertex)
-  test-1
-  (bind ((x (float 2.1d0))
+  test-2
+  (let ((x (float 2.1d0))
          (y (float 2.1d0))
          (g (make-container 'graph-container :vertex-test #'=)))
     (add-vertex g (+ x y))
@@ -40,9 +39,11 @@
 ;;; should do this for each _kind_ of graph
 ;;; ---------------------------------------------------------------------------
 
-(deftestsuite test-basic-graph-properties (test-graph)
-  ((graph-undirected (make-container 'graph-container :default-edge-type :undirected))
-   (graph-directed (make-container 'graph-container :default-edge-type :directed)))
+(deftestsuite test-basic-graph-properties (cl-graph-test)
+  ((graph-undirected (make-container 'graph-container
+                                    :default-edge-type :undirected))
+   (graph-directed (make-container 'graph-container
+                                  :default-edge-type :directed)))
   :setup ((loop for v in '(a b c d e) do
                 (add-vertex graph-undirected v)
                 (add-vertex graph-directed v))
@@ -50,6 +51,15 @@
                 (add-edge-between-vertexes graph-undirected v1 v2)
                 (add-edge-between-vertexes graph-directed v1 v2))))
 
+#+(or)
+(let ((g (make-container 'graph-container
+                        :default-edge-type :directed)))
+  (loop for v in '(a b c d e) do
+                (add-vertex g v))
+  (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
+       (add-edge-between-vertexes g v1 v2))
+  g)
+
 ;;; ---------------------------------------------------------------------------
 
 (addtest (test-basic-graph-properties)
@@ -69,17 +79,15 @@
   (delete-edge-between-vertexes graph-directed 'a 'b)
   (ensure-same (size (graph-edges graph-directed)) 3))
 
-;;; ---------------------------------------------------------------------------
+#|
 
-(deftestsuite test-graph-traversal (test-graph)
+(deftestsuite cl-graph-test-traversal (cl-graph-test)
   ((g (make-container 'graph-container)))
   :setup (loop for (src dst) in '((a b) (a c) (a d) (b e) 
                                   (b f) (d g) (d h) (h i)
                                   (h j)) do
                (add-edge-between-vertexes g src dst :edge-type :directed)))
 
-;;; ---------------------------------------------------------------------------
-
 #|
 
 a - b - e
@@ -91,16 +99,14 @@ a - b - e
 
 |#
 
-(addtest (test-graph-traversal)
+(addtest (cl-graph-test-traversal)
   (let ((result nil))
     (traverse-elements
      g :depth (lambda (v) (push (element v) result)))
     (ensure-same (reverse result) 
                  '(e f b c g i j h d a) :test #'equal)))
 
-;;; ---------------------------------------------------------------------------
-
-(addtest (test-graph-traversal)
+(addtest (cl-graph-test-traversal)
   (let ((result nil))
     (traverse-elements
      g :breadth (lambda (v) (push (element v) result)))
@@ -108,6 +114,7 @@ a - b - e
     (ensure-same (reverse result) 
                  '(a b c d e f g h i j) :test #'equal)))
     
+|#
     
 ;;; ---------------------------------------------------------------------------
 ;;; test-replace-vertex
@@ -147,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)))
@@ -159,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))))
+
+
+  
+