r5459: *** empty log message ***

diff --git a/assert.lisp b/assert.lisp
index d46eaeb530e469e85e3f70dfff4afde0a947ac64..25db1e5e3ca93d8ab70392aeef29e8e4f4a6d237 100644 (file)
--- a/assert.lisp
+++ b/assert.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:       $Id: assert.lisp,v 1.5 2003/08/04 16:42:27 kevin Exp $
+;;;; ID:       $Id: assert.lisp,v 1.6 2003/08/05 22:56:25 kevin Exp $
 ;;;; Purpose:  Assert functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -14,12 +14,14 @@
   ((message :initform nil :initarg :message :accessor message))
   (:documentation "Base class for all test failures."))
 
+(defmethod print-object ((obj assertion-failed) stream)
+  (print-unreadable-object (obj stream :type t :identity nil)
+    (apply #'format stream (simple-condition-format-control obj)
+          (simple-condition-format-arguments obj))))
 
 (defun failure-message (message &optional format-str &rest args)
   "Signal a test failure and exit the test."
-  (signal 'assertion-failed
-         :message message
-         :format-control format-str
+  (signal 'assertion-failed :message message :format-control format-str
          :format-arguments args))
 
 (defun failure (format-str &rest args)
@@ -28,16 +30,20 @@
 
 (defun assert-equal (v1 v2 &optional message)
   (unless (equal v1 v2)
-    (failure-message message "Test equal: ~S ~S" v1 v2)))
+    (failure-message message "Assert equal: ~S ~S" v1 v2)))
 
 (defun assert-eql (v1 v2 &optional message)
   (unless (eql v1 v2)
-    (failure-message message "Test eql: ~S ~S" v1 v2)))
+    (failure-message message "Assert eql: ~S ~S" v1 v2)))
+
+(defun assert-not-eql (v1 v2 &optional message)
+  (when (eql v1 v2)
+    (failure-message message "Assert not eql: ~S ~S" v1 v2)))
 
 (defmacro assert-true (v &optional message)
   `(unless ,v
-    (failure-message message "Not true: ~S" ',v)))
+    (failure-message ,message "Assert true: ~S" ',v)))
 
 (defmacro assert-false (v &optional message)
   `(when ,v
-     (failure-message message "Not false: ~S" ',v)))
+     (failure-message ,message "Assert false: ~S" ',v)))

diff --git a/example.lisp b/example.lisp
index 4a89aec87074524355632b0c8024fff9d10b57e6..5ddd14841436bd9287e9337c10cb7de10cc51f53 100644 (file)
--- a/example.lisp
+++ b/example.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: example.lisp,v 1.7 2003/08/04 19:31:34 kevin Exp $
+;;;; ID:      $Id: example.lisp,v 1.8 2003/08/05 22:56:25 kevin Exp $
 ;;;; Purpose: Example file for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -44,7 +44,7 @@
 ;;; This method is meant to signal a failure
 (def-test-method (test-subtraction-2 test math-test-case :run nil)
   (let ((result (- (numbera test) (numberb test))))
-    (assert-equal result 1)))
+    (assert-equal result 1 "This is meant to failure")))
 
 ;;;; Finally we can run our test suite and see how it performs.
 (textui-test-run (get-suite math-test-case))

diff --git a/package.lisp b/package.lisp
index 68562f23704ce4ffe1303966f09504b7029486d3..24acae2d8f1d007b35fffb2bc9635b030716f2f2 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -2,10 +2,10 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: package.lisp,v 1.8 2003/08/04 19:31:34 kevin Exp $
+;;;; ID:      $Id: package.lisp,v 1.9 2003/08/05 22:56:25 kevin Exp $
 ;;;; Purpose: Package definition for XLUnit
 ;;;;
-;;;; $Id: package.lisp,v 1.8 2003/08/04 19:31:34 kevin Exp $
+;;;; $Id: package.lisp,v 1.9 2003/08/05 22:56:25 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:cl-user)
@@ -28,6 +28,7 @@
    #:assert-false
    #:assert-equal
    #:assert-eql
+   #:assert-not-eql
    #:test-failure
    #:failure
 

diff --git a/printer.lisp b/printer.lisp
index 3637ff454f4b1c49e069a21f676e55d19040fa82..ad351c8e7012efa88fef24a670b541c9bedc6acc 100644 (file)
--- a/printer.lisp
+++ b/printer.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: printer.lisp,v 1.5 2003/08/04 19:31:34 kevin Exp $
+;;;; ID:      $Id: printer.lisp,v 1.6 2003/08/05 22:56:25 kevin Exp $
 ;;;; Purpose: Printer functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -14,51 +14,50 @@
 ; method print-results
 ;----------------------------------------------------------------------
  
-(defmethod print-results ((ob textui-test-runner) result seconds)
-  (format (ostream ob) "~&Time: ~D~%~%" (coerce seconds 'float))
-  (print-header ob result)
-  (print-errors ob result)
-  (print-failures ob result)
-  t)
+(defmethod print-results ((obj textui-test-runner) result seconds)
+  (print-header obj result seconds)
+  (print-defects obj (errors result) "error")
+  (print-defects obj (failures result) "failure")
+  (print-footer obj result)
+  (values))
  
-(defmethod print-header ((ob textui-test-runner) result)
+(defmethod print-header ((obj textui-test-runner) result seconds)
+  (declare (ignore result))
+  (format (ostream obj) "~&Time: ~D~%~%" (coerce seconds 'float)))
+                                                                                
+(defmethod print-defects ((obj textui-test-runner) defects title)
+  (when defects
+    (let ((count (length defects)))
+      (if (= 1 count)
+         (format (ostream obj) "~%There was 1 ~A:~%" title)
+        (format (ostream obj) "~%There were ~D A:~%"
+               count title))
+      (dotimes (i count)
+       (let* ((defect (nth i defects))
+              (condition (thrown-condition defect)))
+         (format (ostream obj) "~A) ~A: "
+                 (1+ i) (name (failed-test defect)))
+         (apply #'format (ostream obj) 
+                (simple-condition-format-control condition)
+                (simple-condition-format-arguments condition))
+         (format (ostream obj) "~%")
+         (when (message condition)
+           (let ((spaces (+ 2 (length (format nil "~D" count)))))
+             (dotimes (i spaces)
+               (write-char #\space (ostream obj))))
+           (format (ostream obj) "~A~%" (message condition))))))))
+
+
+(defmethod print-footer ((obj textui-test-runner) result)
   (let ((failures (failures result))
         (errors (errors result))
         (run-tests (run-tests result)))
     (cond ((and (null failures) (null errors))
-           (format (ostream ob) "~%OK (~a tests)~%" run-tests))
+           (format (ostream obj) "~%OK (~a tests)~%" run-tests))
           (t
-           (format (ostream ob) "~%~%FAILURES!!!~%")
-           (format (ostream ob) "Run: ~a   Failures: ~a   Errors: ~a~%"
+           (format (ostream obj) "~%~%FAILURES!!!~%")
+           (format (ostream obj) "Run: ~a   Failures: ~a   Errors: ~a~%"
                    run-tests (length failures) (length errors))))))
-                                                                                 
-(defmethod print-errors ((ob textui-test-runner) result)
-  (let ((errors (errors result)))
-    (when errors
-      (if (eql (length errors) 1)
-        (format (ostream ob) "~%There was 1 error:~%")
-        (format (ostream ob) "~%There were ~a errors:~%" (length errors)))
-      (let ((i 1))
-        (mapc #'(lambda (single-error)
-                  (format (ostream ob) "~a) ~a: ~a~%" i
-                          (name (failed-test single-error))
-                         (thrown-condition single-error))
-                  (incf i))
-              errors)))))
-
-(defmethod print-failures ((ob textui-test-runner) result)
-  (let ((failures (failures result)))
-    (when failures
-      (if (eql (length failures) 1)
-        (format (ostream ob) "~%There was 1 failure:~%")
-        (format (ostream ob) "~%There were ~a failures:~%" (length failures)))
-      (let ((i 1))
-        (mapc #'(lambda (single-failure)
-                  (format (ostream ob) "~a) ~a: ~a~%" i 
-                         (name (failed-test single-failure))
-                          (or (message (thrown-condition single-failure)) ""))
-                  (incf i))
-              failures)))))
 
 (defgeneric summary (result))
 (defmethod summary ((result test-results))

diff --git a/result.lisp b/result.lisp
index eb49d0fc3773fb557c84e2cc581d918ff5066317..28baaa5644a8f22fe1d85cffab02ec64a9473929 100644 (file)
--- a/result.lisp
+++ b/result.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: result.lisp,v 1.6 2003/08/04 19:31:34 kevin Exp $
+;;;; ID:      $Id: result.lisp,v 1.7 2003/08/05 22:56:25 kevin Exp $
 ;;;; Purpose:  Result functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -56,7 +56,7 @@
 
 (defmethod is-failure ((failure test-failure))
   "Returns T if a failure was a test-failure condition"
-  (typep (thrown-condition failure) 'test-failure-condition))
+  (typep (thrown-condition failure) 'assertion-failed))
 
 (defmethod print-object ((obj test-failure) stream)
   (print-unreadable-object (obj stream :type t :identity nil)

diff --git a/suite.lisp b/suite.lisp
index f2394abecf65b106b677ce896e2776d0ba480dee..391258e26afb373f15de2b9f014b62dc7882c456 100644 (file)
--- a/suite.lisp
+++ b/suite.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: suite.lisp,v 1.6 2003/08/04 19:31:34 kevin Exp $
+;;;; ID:      $Id: suite.lisp,v 1.7 2003/08/05 22:56:25 kevin Exp $
 ;;;; Purpose: Suite functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -42,7 +42,7 @@
   (setf (tests suite)
     (delete-if #'(lambda (existing-tests-or-suite)
                   (cond ((typep existing-tests-or-suite 'test-suite)
-                         (eq existing-tests-or-suite new-test))
+                         (eq existing-tests-or-suite test))
                         ((typep existing-tests-or-suite 'test-case)
                          (eql (name existing-tests-or-suite)
                               (name test)))))

diff --git a/tcase.lisp b/tcase.lisp
index 62cb8bf1629950f382e8814e8ea57718a40d858d..414eee87710dbe47031ecac2719debac1495a0b6 100644 (file)
--- a/tcase.lisp
+++ b/tcase.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: tcase.lisp,v 1.3 2003/08/04 19:58:24 kevin Exp $
+;;;; ID:      $Id: tcase.lisp,v 1.4 2003/08/05 22:56:25 kevin Exp $
 ;;;; Purpose: Test fixtures for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -59,7 +59,7 @@ that the setup method did for this instance."))
 (defmethod run ((ob test) &key (handle-errors t))
   "Generalized to work on test-case and test-suites"
   (let ((res (make-test-results)))
-    (run-on-test-results ob res :handle-errors t)
+    (run-on-test-results ob res :handle-errors handle-errors)
     res))
 
 (defmethod run-on-test-results ((test test-case) result
@@ -87,7 +87,3 @@ that the setup method did for this instance."))
          (add-error res test condition)))
       (run-base test))
   res)
-
-
-
-

diff --git a/tests.lisp b/tests.lisp
index 0cba6c31ee836821a49826788d9da1aec744e292..2659b84ad3a55cba848c9234546cd9f2e1893507 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -2,8 +2,8 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Id:      $Id: tests.lisp,v 1.10 2003/08/04 19:42:18 kevin Exp $
-;;;; Purpose: Test suite for XLUnit
+;;;; Id:      $Id: tests.lisp,v 1.11 2003/08/05 22:56:25 kevin Exp $
+;;;; Purpose: Self Test suite for XLUnit
 ;;;;
 ;;;; *************************************************************************
 
@@ -33,10 +33,28 @@
 (def-test-method (test-broken-method self was-run :run nil)
     (assert-equal pi (/ 22 7)))
 
+(def-test-method (test-not-eql self was-run :run nil)
+    (assert-not-eql (cons t t) (cons t t)))
+
+(def-test-method (test-eql self was-run :run nil)
+    (let ((obj (cons t t)))
+      (assert-eql obj obj)))
+
 (def-test-method (test-error-method self was-run :run nil)
     (error "Err"))
 
 
+;;; Second helper test case
+
+(defclass test-two-cases (test-case)
+  ())
+
+(def-test-method (test-1 self test-two-cases :run nil)
+    (assert-true t))
+
+(def-test-method (test-2 self test-two-cases :run nil)
+    (assert-false nil))
+
 ;;; Main test fixture
 
 (defclass test-case-test (test-case)
@@ -50,7 +68,17 @@
 
 (def-test-method (test-results self test-case-test :run nil)
   (assert-equal "1 run, 0 erred, 0 failed" 
-               (summary (run (named-test 'test-method (get-suite was-run))))))
+               (summary (run (named-test 'test-method 
+                                         (get-suite was-run))))))
+
+(def-test-method (test-eql self test-case-test :run nil)
+  (assert-equal "1 run, 0 erred, 0 failed" 
+               (summary (run (named-test 'test-eql (get-suite was-run))))))
+
+(def-test-method (test-not-eql self test-case-test :run nil)
+  (assert-equal "1 run, 0 erred, 0 failed" 
+               (summary (run (named-test 'test-not-eql
+                                         (get-suite was-run))))))
 
 (def-test-method (test-fn self test-case-test :run nil)
   (let ((test (make-instance 'test-case :name 'test-fn
@@ -82,8 +110,8 @@
     (assert-equal "2 run, 0 erred, 1 failed" (summary result))))
 
 (def-test-method (test-dynamic-suite self test-case-test :run nil)
-  (assert-equal "3 run, 1 erred, 1 failed" 
-               (summary (run (get-suite was-run)))))
+  (assert-equal "2 run, 0 erred, 0 failed" 
+               (summary (run (get-suite test-two-cases)))))
 
 
 (textui-test-run (get-suite test-case-test))

diff --git a/xlunit.asd b/xlunit.asd
index c7f293af20e0faba8ba17b02fe01833ffb6388be..a3f5e27b2ac603ae84f4161693385ba6b7bc3f86 100644 (file)
--- a/xlunit.asd
+++ b/xlunit.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2003
 ;;;;
-;;;; $Id: xlunit.asd,v 1.5 2003/08/04 19:31:34 kevin Exp $
+;;;; $Id: xlunit.asd,v 1.6 2003/08/05 22:56:25 kevin Exp $
 ;;;; *************************************************************************
 
 (defpackage #:xlunit-system (:use #:asdf #:cl))
@@ -34,14 +34,16 @@
    ))
 
 (defmethod perform ((o test-op) (c (eql (find-system 'xlunit))))
-  (oos 'load-op 'xlunit-tests :force t)
-  (oos 'test-op 'xlunit-tests :force t))
+  (operate 'load-op 'xlunit-tests :force t)
+  (operate 'test-op 'xlunit-tests :force t))
 
 (defsystem xlunit-tests
     :depends-on (xlunit)
     :components ((:file "tests")))
 
 (defmethod perform ((o test-op) (c (eql (find-system 'xlunit-tests))))
+  (operate 'load-op 'xlunit-tests)
   (or (funcall (intern (symbol-name '#:do-tests)
                       (find-package '#:xlunit-tests)))
       (error "test-op failed")))
+