-
-(defmethod setup-testsuite-named (name)
- (declare (ignore name))
- t)
-
-(defmethod teardown-testsuite-named (name)
- (declare (ignore name))
- t)
-
-(defmethod run-test ((suite test-suite)
- &key (result (make-instance 'test-result))
- (handle-errors t))
- (setup-testsuite-named (slot-value suite 'name))
- (dolist (test (tests suite))
- (run-test test :result result :handle-errors handle-errors))
- (teardown-testsuite-named (slot-value suite 'name))
- result)
-
-(defmethod tests ((suite test-suite))
- (let ((tlist nil))
- (maphash #'(lambda (k v)
- (declare (ignore k))
- (setf tlist (cons v tlist)))
- (tests-hash suite))
- (reverse tlist)))
-
-
-(defun make-test-suite (name-or-fixture &optional description testspecs)
- "Returns a new test-suite based on a name and TESTSPECS or a fixture
-instance"
- (etypecase name-or-fixture
- (symbol
- (make-test-suite-for-fixture (make-instance name-or-fixture)))
- (string
- (let ((suite (make-instance 'test-suite :name name-or-fixture
- :description description)))
- (dolist (testspec testspecs)
- (add-test (apply #'make-test testspec) suite))
- suite))))
-
-
-(defmethod add-test ((test test-fixture) (suite test-suite))
- (setf (gethash (test-name test) (tests-hash suite)) test))
-
-(defmethod add-test ((test test-suite) (suite test-suite))
- (setf (gethash (test-suite-name test) (tests-hash suite)) test))
-
-(defmethod remove-test ((test test-fixture) (suite test-suite))
- (remhash (test-name test) (tests-hash suite)))
-
-(defmethod remove-test ((test test-suite) (suite test-suite))
- (remhash (test-suite-name test) (tests-hash suite)))
-
-(defmethod test-named ((name string) (suite test-suite))
- (gethash name (tests-hash suite)))
-
+(defmacro get-suite (class-name)
+ `(suite (make-instance ',class-name)))
+
+
+(defmethod add-test ((ob test-suite) (new-test test))
+ (remove-test new-test ob)
+ (setf (tests ob) (append (tests ob) (list new-test))))
+
+
+(defmethod run-on-test-results ((ob test-suite) (result test-results)
+ &key (handle-errors t))
+ (mapc #'(lambda (composite) ;;test-case or suite
+ (run-on-test-results composite result
+ :handle-errors handle-errors))
+ (tests ob)))
+
+(defmethod named-test (name (suite test-suite))
+ (some (lambda (test-or-suite)
+ (when (and (typep test-or-suite 'test-case)
+ (equal name (name test-or-suite)))
+ test-or-suite))
+ (tests suite)))
+
+(defmethod remove-test ((test test) (suite test-suite))
+ (setf (tests suite)
+ (delete-if #'(lambda (existing-tests-or-suite)
+ (cond ((typep existing-tests-or-suite 'test-suite)
+ (eq existing-tests-or-suite test))
+ ((typep existing-tests-or-suite 'test-case)
+ (eql (name existing-tests-or-suite)
+ (name test)))))
+ (tests suite))))