From: Kevin M. Rosenberg Date: Fri, 31 Aug 2007 18:04:31 +0000 (+0000) Subject: r11859: Canonicalize whitespace X-Git-Tag: debian-0.6.2-2~2 X-Git-Url: http://git.kpe.io/?p=xlunit.git;a=commitdiff_plain;h=ca683dc694122458db8864fe6519b3e07899b045 r11859: Canonicalize whitespace --- diff --git a/assert.lisp b/assert.lisp index 6a38751..ec82b4c 100644 --- a/assert.lisp +++ b/assert.lisp @@ -10,19 +10,19 @@ (in-package #:xlunit) -(define-condition assertion-failed (simple-condition) +(define-condition assertion-failed (simple-condition) ((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)))) + (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 - :format-arguments args)) + :format-arguments args)) (defun failure (format-str &rest args) "Signal a test failure and exit the test." @@ -51,28 +51,28 @@ (defmacro assert-condition (condition form &optional message) (let ((cond (gensym "COND-"))) `(handler-case - (progn - ,form - (values)) + (progn + ,form + (values)) (t (,cond) - (when (and (typep ,cond 'serious-condition) - (not (typep ,cond ,condition))) - (failure-message - ,message - "Assert condition ~A, but signaled condition ~A" - ,condition ,cond))) + (when (and (typep ,cond 'serious-condition) + (not (typep ,cond ,condition))) + (failure-message + ,message + "Assert condition ~A, but signaled condition ~A" + ,condition ,cond))) (:no-error () - (failure-message ,message - "Assert condition ~A, but no condition signaled" - ,condition))))) + (failure-message ,message + "Assert condition ~A, but no condition signaled" + ,condition))))) (defmacro assert-not-condition (condition form &optional message) (let ((cond (gensym "COND-"))) `(handler-case - (progn - ,form - (values)) + (progn + ,form + (values)) (serious-condition (,cond) - (unless (typep ,cond ,condition) - (failure-message ,message "Assert not condition ~A" - ,condition)))))) + (unless (typep ,cond ,condition) + (failure-message ,message "Assert not condition ~A" + ,condition)))))) diff --git a/fixture.lisp b/fixture.lisp index dab8e53..4238a9d 100644 --- a/fixture.lisp +++ b/fixture.lisp @@ -48,41 +48,41 @@ that the setup method did for this instance.")) `(if ,test (handler-case ,form - ,@cases) + ,@cases) ,form)) (defmacro unwind-protect-if (test protected cleanup) `(if ,test (unwind-protect - ,protected - ,cleanup) + ,protected + ,cleanup) (progn ,protected ,cleanup))) (defmethod run-test ((test test-fixture) - &key (result (make-instance 'test-result)) - (handle-errors t)) + &key (result (make-instance 'test-result)) + (handle-errors t)) "Perform the test represented by the given test-case or test-suite. Returns a test-result object." (incf (test-count result)) (with-slots (failures errors) result (unwind-protect-if handle-errors - (handler-case-if handle-errors - (let ((res (progn (setup test) - (funcall (test-fn test) test)))) - (when (typep res 'test-failure-condition) - (push (make-test-failure test res) failures))) - (test-failure-condition (failure) - (push (make-test-failure test failure) failures)) - (error (err) - (push (make-test-failure test err) errors))) - - (if handle-errors - (handler-case - (teardown test) - (error (err) - (push (make-test-failure test err) errors))) - (teardown test)))) + (handler-case-if handle-errors + (let ((res (progn (setup test) + (funcall (test-fn test) test)))) + (when (typep res 'test-failure-condition) + (push (make-test-failure test res) failures))) + (test-failure-condition (failure) + (push (make-test-failure test failure) failures)) + (error (err) + (push (make-test-failure test err) errors))) + + (if handle-errors + (handler-case + (teardown test) + (error (err) + (push (make-test-failure test err) errors))) + (teardown test)))) result) @@ -92,15 +92,15 @@ the method that will be invoked when perfoming this test, and can be a symbol or a lambda taking a single argument, the test-fixture instance. DESCRIPTION is obviously what it says it is." (let ((newtest (make-instance fixture - :test-name (etypecase name - (symbol - (string-downcase (symbol-name name))) - (string - name)) - :test-fn - (if(and (symbolp name) (null test-fn)) - name - test-fn) - :description description))) + :test-name (etypecase name + (symbol + (string-downcase (symbol-name name))) + (string + name)) + :test-fn + (if(and (symbolp name) (null test-fn)) + name + test-fn) + :description description))) (when test-suite (add-test newtest test-suite)) newtest)) diff --git a/listener.lisp b/listener.lisp index 7ed2454..aaa72e6 100644 --- a/listener.lisp +++ b/listener.lisp @@ -18,4 +18,4 @@ (defmethod end-test ((obj test-listener) tcase) (declare (ignore tcase))) - + diff --git a/package.lisp b/package.lisp index d2cd550..cba40e0 100644 --- a/package.lisp +++ b/package.lisp @@ -13,7 +13,7 @@ (defpackage #:xlunit (:use #:cl) (:export - + ;; test-case.lisp #:test-case #:def-test-method @@ -50,10 +50,10 @@ #:suite #:test-suite #:run-on-test-results - + ;; printer.lisp #:summary - + ;; result.lisp #:test-results #:make-test-results diff --git a/printer.lisp b/printer.lisp index 5696948..a590a3b 100644 --- a/printer.lisp +++ b/printer.lisp @@ -13,43 +13,43 @@ ;---------------------------------------------------------------------- ; method print-results ;---------------------------------------------------------------------- - + (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 ((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 was 1 ~A:~%" title) (format (ostream obj) "~%There were ~D ~A:~%" - count title)) + 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))) - (typecase condition - (assertion-failed - (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)))) - (t - (format (ostream obj) "~A~%" condition)))))))) + (let* ((defect (nth i defects)) + (condition (thrown-condition defect))) + (format (ostream obj) "~A) ~A: " + (1+ i) (name (failed-test defect))) + (typecase condition + (assertion-failed + (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)))) + (t + (format (ostream obj) "~A~%" condition)))))))) (defmethod print-footer ((obj textui-test-runner) result) @@ -66,4 +66,4 @@ (defgeneric summary (result)) (defmethod summary ((result test-results)) (format nil "~D run, ~D erred, ~D failed" - (run-tests result) (error-count result) (failure-count result))) + (run-tests result) (error-count result) (failure-count result))) diff --git a/result.lisp b/result.lisp index f2c4893..80f411a 100644 --- a/result.lisp +++ b/result.lisp @@ -32,8 +32,8 @@ (defmethod start-test ((tcase test) (res test-results)) (incf (run-tests res)) (mapc (lambda (listener) - (start-test listener tcase)) - (listeners res)) + (start-test listener tcase)) + (listeners res)) res) (defmethod end-test ((tcase test) (res test-results)) @@ -49,12 +49,12 @@ (defclass test-failure () ((failed-test :initarg :failed-test :reader failed-test) (thrown-condition :initarg :thrown-condition - :reader thrown-condition)) + :reader thrown-condition)) (:documentation "Stored failures/errors in test-results slots")) (defun make-test-failure (test condition) (make-instance 'test-failure :failed-test test - :thrown-condition condition)) + :thrown-condition condition)) (defmethod is-failure ((failure test-failure)) "Returns T if a failure was a test-failure condition" @@ -63,9 +63,9 @@ (defmethod print-object ((obj test-failure) stream) (print-unreadable-object (obj stream :type t :identity nil) (format stream "~A: " (failed-test obj)) - (apply #'format stream - (simple-condition-format-control (thrown-condition obj)) - (simple-condition-format-arguments (thrown-condition obj))))) + (apply #'format stream + (simple-condition-format-control (thrown-condition obj)) + (simple-condition-format-arguments (thrown-condition obj))))) (defmethod was-successful ((result test-results)) "Returns T if a result has no failures or errors" @@ -79,13 +79,13 @@ (defmethod add-error ((ob test-results) (tcase test-case) condition) (push (make-test-failure tcase condition) (errors ob)) (mapc #'(lambda (single-listener) - (add-error single-listener tcase condition)) - (listeners ob))) + (add-error single-listener tcase condition)) + (listeners ob))) (defmethod add-failure ((ob test-results) (tcase test-case) condition) (push (make-test-failure tcase condition) (failures ob)) (mapc #'(lambda (single-listener) - (add-failure single-listener tcase condition)) - (listeners ob))) + (add-failure single-listener tcase condition)) + (listeners ob))) diff --git a/suite.lisp b/suite.lisp index 4a94247..2542117 100644 --- a/suite.lisp +++ b/suite.lisp @@ -13,11 +13,11 @@ ((name :initform "" :initarg :name :reader test-suite-name) (tests :initarg :tests :accessor tests :initform nil) (description :initarg :description :reader description - :initform "No description."))) + :initform "No description."))) (defmacro get-suite (class-name) `(suite (make-instance ',class-name))) - + (defmethod add-test ((ob test-suite) (new-test test)) (remove-test new-test ob) @@ -25,28 +25,28 @@ (defmethod run-on-test-results ((ob test-suite) (result test-results) - &key (handle-errors t)) + &key (handle-errors t)) (mapc #'(lambda (composite) ;;test-case or suite (run-on-test-results composite result - :handle-errors handle-errors)) + :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))) + (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)))) + (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)))) ;; Dynamic test suite @@ -55,28 +55,28 @@ class of an instance and whose name begins with the string 'test-'. This is used to dynamically generate a list of tests for a fixture." (let ((res) - (package (symbol-package (class-name (class-of instance))))) + (package (symbol-package (class-name (class-of instance))))) (do-symbols (s package) (when (and (> (length (symbol-name s)) 5) - (string-equal "test-" (subseq (symbol-name s) 0 5)) - (fboundp s) - (typep (symbol-function s) 'generic-function) - (ignore-errors - (plusp (length (compute-applicable-methods - (ensure-generic-function s) - (list instance)))))) - (push s res))) + (string-equal "test-" (subseq (symbol-name s) 0 5)) + (fboundp s) + (typep (symbol-function s) 'generic-function) + (ignore-errors + (plusp (length (compute-applicable-methods + (ensure-generic-function s) + (list instance)))))) + (push s res))) (nreverse res))) (defmacro def-test-method (method-name ((instance-name class-name) - &key (run t)) - &body method-body) + &key (run t)) + &body method-body) `(let ((,instance-name (make-instance ',class-name :name ',method-name))) (setf (method-body ,instance-name) #'(lambda() ,@method-body)) (add-test (suite ,instance-name) ,instance-name) - (when ,run + (when ,run (textui-test-run ,instance-name)))) diff --git a/tcase.lisp b/tcase.lisp index 3d5ee66..7aefbdd 100644 --- a/tcase.lisp +++ b/tcase.lisp @@ -15,17 +15,17 @@ (defclass test-case (test) ((existing-suites :initform nil :accessor existing-suites - :allocation :class) + :allocation :class) (method-body :initarg :method-body :accessor method-body :initform nil :documentation "A function designator which will be applied to this instance to perform that test-case.") (name :initarg :name :reader name :initform "" - :documentation "The name of this test-case, used in reports.") + :documentation "The name of this test-case, used in reports.") (description :initarg :description :reader description - :documentation - "Short description of this test-case, uses in reports") + :documentation + "Short description of this test-case, uses in reports") (suite :initform nil :accessor suite :initarg :suite)) (:documentation "Base class for test-cases.")) @@ -38,7 +38,7 @@ to perform that test-case.") (setf (gethash (type-of ob) (existing-suites ob)) (make-instance 'test-suite))) ;;specifi suite singleton (setf (suite ob) (gethash (type-of ob) (existing-suites ob)))) - + (defgeneric set-up (test) (:documentation @@ -63,7 +63,7 @@ that the setup method did for this instance.")) res)) (defmethod run-on-test-results ((test test-case) result - &key (handle-errors t)) + &key (handle-errors t)) (start-test test result) (run-protected test result :handle-errors handle-errors) (end-test test result)) @@ -80,10 +80,10 @@ that the setup method did for this instance.")) (defmethod run-protected ((test test-case) res &key (handle-errors t)) (if handle-errors (handler-case - (run-base test) - (assertion-failed (condition) - (add-failure res test condition)) - (serious-condition (condition) - (add-error res test condition))) + (run-base test) + (assertion-failed (condition) + (add-failure res test condition)) + (serious-condition (condition) + (add-error res test condition))) (run-base test)) res) diff --git a/tests.lisp b/tests.lisp index b14b689..06f4a0b 100644 --- a/tests.lisp +++ b/tests.lisp @@ -27,10 +27,10 @@ (defmethod tear-down ((self was-run)) (setf (ws-log self) - (concatenate 'string (ws-log self) "teardown "))) + (concatenate 'string (ws-log self) "teardown "))) (def-test-method test-method ((self was-run) :run nil) - (setf (ws-log self) + (setf (ws-log self) (concatenate 'string (ws-log self) "test-method "))) (def-test-method test-broken-method ((self was-run) :run nil) @@ -51,8 +51,8 @@ #+ignore (def-test-method test-not-condition-with-cond ((self was-run) :run nil) - (assert-not-condition 'test-condition - (signal 'test-condition))) + (assert-not-condition 'test-condition + (signal 'test-condition))) ;;; Second helper test case @@ -78,79 +78,79 @@ (assert-equal (ws-log test) "setup test-method teardown "))) (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)))))) + (assert-equal "1 run, 0 erred, 0 failed" + (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)))))) + (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)))))) + (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 - :method-body - (lambda () - (declare (ignore test)) - (assert-equal 10 10))))) + :method-body + (lambda () + (declare (ignore test)) + (assert-equal 10 10))))) (assert-equal "1 run, 0 erred, 0 failed" - (summary (run test))))) + (summary (run test))))) (def-test-method test-failed-result ((self test-case-test) :run nil) (assert-equal "1 run, 0 erred, 1 failed" - (summary (run - (named-test 'test-broken-method - (get-suite was-run)))))) + (summary (run + (named-test 'test-broken-method + (get-suite was-run)))))) (def-test-method test-error-result ((self test-case-test) :run nil) (assert-equal "1 run, 1 erred, 0 failed" - (summary (run - (named-test 'test-error-method - (get-suite was-run)))))) - + (summary (run + (named-test 'test-error-method + (get-suite was-run)))))) + (def-test-method test-suite ((self test-case-test) :run nil) (let ((suite (make-instance 'test-suite)) - (result (make-test-results))) + (result (make-test-results))) (add-test suite (named-test 'test-method (get-suite was-run))) (add-test suite (named-test 'test-broken-method (get-suite was-run))) (run-on-test-results suite result) (assert-equal "2 run, 0 erred, 1 failed" (summary result)))) (def-test-method test-dynamic-suite ((self test-case-test) :run nil) - (assert-equal "2 run, 0 erred, 0 failed" - (summary (run (get-suite test-two-cases))))) + (assert-equal "2 run, 0 erred, 0 failed" + (summary (run (get-suite test-two-cases))))) (def-test-method test-condition ((self test-case-test) :run nil) - (assert-condition - 'test-condition + (assert-condition + 'test-condition (error 'test-condition))) -(def-test-method test-condition-without-cond ((self test-case-test) - :run nil) +(def-test-method test-condition-without-cond ((self test-case-test) + :run nil) (assert-equal "1 run, 0 erred, 1 failed" - (summary (run - (named-test 'test-condition-without-cond - (get-suite was-run)))))) + (summary (run + (named-test 'test-condition-without-cond + (get-suite was-run)))))) #+ignore (def-test-method test-not-condition ((self test-case-test) :run nil) - (assert-not-condition - 'test-condition + (assert-not-condition + 'test-condition (progn))) #+ignore -(def-test-method test-not-condition-with-cond ((self test-case-test) - :run nil) +(def-test-method test-not-condition-with-cond ((self test-case-test) + :run nil) (assert-equal "1 run, 0 erred, 1 failed" - (summary (run - (named-test 'test-not-condition-with-cond - (get-suite was-run)))))) - -#+ignore + (summary (run + (named-test 'test-not-condition-with-cond + (get-suite was-run)))))) + +#+ignore (textui-test-run (get-suite test-case-test)) diff --git a/textui.lisp b/textui.lisp index 5eab0f8..db50929 100644 --- a/textui.lisp +++ b/textui.lisp @@ -14,27 +14,27 @@ (defclass textui-test-runner (test-listener) ((ostream :initform nil :accessor ostream :initarg :ostream)) (:default-initargs :ostream *standard-output*)) - + (defmethod add-error ((ob textui-test-runner) test-case condition) (declare (ignore test-case condition)) (format (ostream ob) "E")) - + (defmethod add-failure ((ob textui-test-runner) test-case condition) (declare (ignore test-case condition)) (format (ostream ob) "F")) - + (defmethod start-test ((ob textui-test-runner) test-case) (declare (ignore test-case)) (format (ostream ob) ".")) - + (defmethod textui-test-run ((ob test)) (let ((test-runner (make-instance 'textui-test-runner)) (result (make-instance 'test-results)) - (start-time (get-internal-real-time))) + (start-time (get-internal-real-time))) (add-listener result test-runner) (run-on-test-results ob result) - (print-results test-runner result - (/ (- (get-internal-real-time) start-time) - internal-time-units-per-second)) + (print-results test-runner result + (/ (- (get-internal-real-time) start-time) + internal-time-units-per-second)) result))