Tests are mostly broken; but you can perform a test-op

darcs-hash:20060428154136-3cc5d-7aea16e80a7a98ded81617057582e8f7e8b5f142.gz

diff --git a/cl-graph-test.asd b/cl-graph-test.asd
index 1c58ada..70ca537 100644 (file)
--- a/cl-graph-test.asd
+++ b/cl-graph-test.asd
@@ -17,23 +17,32 @@
 
   :components ((:module "unit-tests"
                         :components ((:file "package")
-                                     (:file "test*" :depends-on ("package"))))
+                                     (:file "test-graph" :depends-on ("package"))
+                                     (:file "test-graph-container" :depends-on ("test-graph"))
+                                     (:file "test-connected-components" :depends-on ("test-graph"))
+                                     (:file "test-graph-metrics" :depends-on ("test-graph"))
+                                     (:file "test-graph-algorithms" :depends-on ("test-graph"))
+                                     ))
                
                (:module "dev"
                         :components ((:static-file "notes.text"))))
   
-  :in-order-to ((test-op (load-op moptilities-test)))
-  
-  :perform (test-op :after (op c)
-                    (describe
-                     (funcall 
-                      (intern (symbol-name '#:run-tests) '#:lift) 
-                      :suite (intern (symbol-name '#:cl-graph-test) '#:cl-graph-test))))
+  :in-order-to ((test-op (load-op cl-graph-test)))
   :depends-on (cl-graph lift))
 
 ;;; ---------------------------------------------------------------------------
 
-(defmethod operation-done-p 
-           ((o test-op)
-            (c (eql (find-system 'moptilities-test))))
+(defmethod perform :after ((op test-op ) (c (eql (find-system 'cl-graph-test))))
+  (describe
+   (funcall 
+    (intern (symbol-name '#:run-tests) '#:lift) 
+    :suite (intern (symbol-name '#:cl-graph-test) '#:cl-graph-test))))
+
+;;; ---------------------------------------------------------------------------
+
+(defmethod perform :after ((o load-op) (c (eql (find-system 'cl-graph-test))))
+  )
+
+(defmethod operation-done-p ((o test-op) (c (eql (find-system 'cl-graph-test))))
+  ;; testing is never done...
   (values nil))

diff --git a/unit-tests/package.lisp b/unit-tests/package.lisp
new file mode 100644 (file)
index 0000000..750446c
--- /dev/null
+++ b/unit-tests/package.lisp
@@ -0,0 +1,4 @@
+(in-package common-lisp-user)
+
+(defpackage #:cl-graph-test
+  (:use #:common-lisp #:cl-graph #:lift #:metatilities))
\ No newline at end of file

diff --git a/unit-tests/test-connected-components.lisp b/unit-tests/test-connected-components.lisp
index 53b8fce..0b0b16e 100644 (file)
--- a/unit-tests/test-connected-components.lisp
+++ b/unit-tests/test-connected-components.lisp
@@ -1,4 +1,4 @@
-(in-package metabang.graph)
+(in-package cl-graph-test)
 
 (deftestsuite test-connected-component ()
   ())

diff --git a/unit-tests/test-graph-algorithms.lisp b/unit-tests/test-graph-algorithms.lisp
index f54b879..4502784 100644 (file)
--- a/unit-tests/test-graph-algorithms.lisp
+++ b/unit-tests/test-graph-algorithms.lisp
@@ -1,4 +1,4 @@
-(in-package cl-graph)
+(in-package cl-graph-test)
 
 (deftestsuite test-connected-components ()
   ())
@@ -113,6 +113,7 @@
 
 ;;; ---------------------------------------------------------------------------
 
+#+Ignore
 (let ((graph (make-container 'graph-container)))
   (loop for (a b) in '((r s) (r v) (s w) (t u) (t w) (t x) 
                        (u y) (w x) (x y)) do

diff --git a/unit-tests/test-graph-container.lisp b/unit-tests/test-graph-container.lisp
index c2697da..87d943a 100644 (file)
--- a/unit-tests/test-graph-container.lisp
+++ b/unit-tests/test-graph-container.lisp
@@ -1,4 +1,4 @@
-(in-package metabang.graph)
+(in-package cl-graph-test)
 
 ;;; ---------------------------------------------------------------------------
 ;;; utilities

diff --git a/unit-tests/test-graph-metrics.lisp b/unit-tests/test-graph-metrics.lisp
index 8071a08..f4d7216 100644 (file)
--- a/unit-tests/test-graph-metrics.lisp
+++ b/unit-tests/test-graph-metrics.lisp
@@ -1,4 +1,4 @@
-(in-package metabang.graph)
+(in-package cl-graph-test)
 
 ;;; ---------------------------------------------------------------------------
 

diff --git a/unit-tests/test-graph.lisp b/unit-tests/test-graph.lisp
index a94dd28..2cd3d82 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,16 +10,15 @@
     (inspect g)))
 |#
 
-(deftestsuite test-graph () ())
-
+(deftestsuite cl-graph-test () ())
 
 (deftestsuite test-test-vertex () ())
 
 (addtest (test-test-vertex)
   test-1
-  (bind ((x (float 2.1d0))
-         (y (float 2.1d0))
-         (g (make-container 'graph-container)))
+  (metatilities:bind ((x (float 2.1d0))
+                     (y (float 2.1d0))
+                     (g (make-container 'graph-container)))
     (add-vertex g (+ x y))
     (add-vertex g (+ x y))
     
@@ -40,7 +39,7 @@
 ;;; should do this for each _kind_ of graph
 ;;; ---------------------------------------------------------------------------
 
-(deftestsuite test-basic-graph-properties (test-graph)
+(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
@@ -71,7 +70,7 @@
 
 ;;; ---------------------------------------------------------------------------
 
-(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)
@@ -91,7 +90,7 @@ 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)))
@@ -100,7 +99,7 @@ a - b - e
 
 ;;; ---------------------------------------------------------------------------
 
-(addtest (test-graph-traversal)
+(addtest (cl-graph-test-traversal)
   (let ((result nil))
     (traverse-elements
      g :breadth (lambda (v) (push (element v) result)))