Setting a test suite at last

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

diff --git a/unit-tests/test-graph.lisp b/unit-tests/test-graph.lisp
new file mode 100644 (file)
index 0000000..a94dd28
--- /dev/null
+++ b/unit-tests/test-graph.lisp
@@ -0,0 +1,167 @@
+(in-package metabang.graph)
+
+#|
+(let ((g (make-container 'graph-container))) 
+  (add-edge-between-vertexes g 'a 'b)
+  (let ((v-a (find-vertex g 'a))
+        (v-b (find-vertex g 'b)))
+    (print (compute-applicable-methods #'(SETF ELEMENT) (list :NEW-A V-A)))
+    (setf (element v-a) :new-a)
+    (inspect g)))
+|#
+
+(deftestsuite test-graph () ())
+
+
+(deftestsuite test-test-vertex () ())
+
+(addtest (test-test-vertex)
+  test-1
+  (bind ((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))
+         (y (float 2.1d0))
+         (g (make-container 'graph-container :vertex-test #'=)))
+    (add-vertex g (+ x y))
+    (add-vertex g (+ x y))
+    
+    (ensure-same (size g) 1)))
+
+
+;;; ---------------------------------------------------------------------------
+;;; 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)))
+  :setup ((loop for v in '(a b c d e) do
+                (add-vertex graph-undirected v)
+                (add-vertex graph-directed v))
+          (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do
+                (add-edge-between-vertexes graph-undirected v1 v2)
+                (add-edge-between-vertexes graph-directed v1 v2))))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-basic-graph-properties)
+  (ensure-same (size (graph-vertexes graph-directed)) 5 :test #'=)
+  (ensure-same (size (graph-edges graph-directed)) 4 :test #'=))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-basic-graph-properties)
+  (delete-edge-between-vertexes graph-directed 'a 'b)
+  (ensure (null (find-edge-between-vertexes graph-directed 'a 'b
+                                            :error-if-not-found? nil))))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-basic-graph-properties)
+  (delete-edge-between-vertexes graph-directed 'a 'b)
+  (ensure-same (size (graph-edges graph-directed)) 3))
+
+;;; ---------------------------------------------------------------------------
+
+(deftestsuite test-graph-traversal (test-graph)
+  ((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
+      - f
+  - c 
+  - d - g
+      - h - i
+          - j
+
+|#
+
+(addtest (test-graph-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)
+  (let ((result nil))
+    (traverse-elements
+     g :breadth (lambda (v) (push (element v) result)))
+    ;(print (reverse result))
+    (ensure-same (reverse result) 
+                 '(a b c d e f g h i j) :test #'equal)))
+    
+    
+;;; ---------------------------------------------------------------------------
+;;; test-replace-vertex
+;;; ---------------------------------------------------------------------------
+
+(deftestsuite test-replace-vertex (test-basic-graph-properties) ())
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-replace-vertex)
+  test-directed
+  (let ((b (find-vertex graph-directed 'b))
+        (x (make-vertex-for-graph graph-directed :element 'x)))
+    (replace-vertex graph-directed b x)
+    (ensure (find-vertex graph-directed 'x))
+    (ensure (not (find-vertex graph-directed 'b nil)))
+    (ensure-same (edge-count (find-vertex graph-directed 'x)) 2 :test =)
+    (ensure (find-edge-between-vertexes graph-directed 'a 'x))
+    (ensure (find-edge-between-vertexes graph-directed 'x 'd))))
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-replace-vertex)
+  test-undirected
+  (let ((b (find-vertex graph-undirected 'b))
+        (x (make-vertex-for-graph graph-undirected :element 'x)))
+    (replace-vertex graph-undirected b x)
+    (ensure (find-vertex graph-undirected 'x))
+    (ensure (not (find-vertex graph-undirected 'b nil)))
+    (ensure-same (edge-count (find-vertex graph-undirected 'x)) 2 :test =)
+    (ensure (find-edge-between-vertexes graph-undirected 'a 'x))
+    (ensure (find-edge-between-vertexes graph-undirected 'x 'd))))
+
+;;; ---------------------------------------------------------------------------
+;;; change vertex value
+;;; ---------------------------------------------------------------------------
+
+(deftestsuite test-change-vertex-value (test-basic-graph-properties) ())
+
+;;; ---------------------------------------------------------------------------
+
+(addtest (test-change-vertex-value)
+  test-undirected
+  (let ((b (find-vertex graph-undirected 'b)))
+    (setf (element b) 'x)
+    (ensure (find-vertex graph-undirected 'x))
+    (ensure (not (find-vertex graph-undirected 'b nil)))
+    (ensure-same (edge-count (find-vertex graph-undirected 'x)) 2 :test =)
+    (ensure (find-edge-between-vertexes graph-undirected 'a 'x))
+    (ensure (find-edge-between-vertexes graph-undirected 'x 'd))))
+
+
+
+;;; ---------------------------------------------------------------------------
+;;; test-replace-edge
+;;; ---------------------------------------------------------------------------
+