From 7f58715215c93f4ab9607eb940d8c0437c892252 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 31 Aug 2007 18:04:31 +0000 Subject: [PATCH] r11859: Canonicalize whitespace --- xptest-example.lisp | 28 +++++----- xptestsuite.lisp | 122 ++++++++++++++++++++++---------------------- 2 files changed, 75 insertions(+), 75 deletions(-) diff --git a/xptest-example.lisp b/xptest-example.lisp index d93bae1..e96d0bf 100644 --- a/xptest-example.lisp +++ b/xptest-example.lisp @@ -59,20 +59,20 @@ (let ((result (+ (numbera test) (numberb test)))) (unless (= result 5) (failure "Result was not 5 when adding ~A and ~A" - (numbera test) (numberb test))))) + (numbera test) (numberb test))))) (defmethod subtraction-test ((test math-fixture)) (let ((result (- (numberb test) (numbera test)))) (unless (= result 1) (failure "Result was not 1 when subtracting ~A ~A" - (numberb test) (numbera test))))) + (numberb test) (numbera test))))) ;;; This method is meant to signal a failure (defmethod subtraction-test2 ((test math-fixture)) (let ((result (- (numbera test) (numberb test)))) (unless (= result 1) (failure "Result was not 1 when subtracting ~A ~A" - (numbera test) (numberb test))))) + (numbera test) (numberb test))))) ;;; Now we can create a test-suite. A test-suite contains a group of @@ -83,19 +83,19 @@ ;;; test-case. (setf math-test-suite (make-test-suite - "Math Test Suite" - "Simple test suite for arithmetic operators." - ("Addition Test" 'math-fixture - :test-thunk 'addition-test - :description "A simple test of the + operator") - ("Subtraction Test" 'math-fixture - :test-thunk 'subtraction-test - :description "A simple test of the - operator"))) + "Math Test Suite" + "Simple test suite for arithmetic operators." + ("Addition Test" 'math-fixture + :test-thunk 'addition-test + :description "A simple test of the + operator") + ("Subtraction Test" 'math-fixture + :test-thunk 'subtraction-test + :description "A simple test of the - operator"))) (add-test (make-test-case "Substraction Test 2" 'math-fixture - :test-thunk 'subtraction-test2 - :description "A broken substraction test, should fail.") - math-test-suite) + :test-thunk 'subtraction-test2 + :description "A broken substraction test, should fail.") + math-test-suite) ;;;; Finally we can run our test suite and see how it performs. ;;;; (report-result (run-test math-test-suite) :verbose t) diff --git a/xptestsuite.lisp b/xptestsuite.lisp index b873902..49e2d61 100644 --- a/xptestsuite.lisp +++ b/xptestsuite.lisp @@ -75,10 +75,10 @@ setup method did for this instance." (defun failure (format-str &rest args) "Signal a test failure and exit the test." (signal 'test-failure - #+(or cmu allegro openmcl) :format-control - #-(or cmu allegro openmcl) :format-string - format-str - :format-arguments args)) + #+(or cmu allegro openmcl) :format-control + #-(or cmu allegro openmcl) :format-string + format-str + :format-arguments args)) (defmacro test-assert (test) `(unless ,test @@ -93,14 +93,14 @@ 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 (handle-errors t)) @@ -108,28 +108,28 @@ setup method did for this instance." Returns one or more test-result objects, one for each test-case performed." (let ((start-time (get-universal-time)) - (failures ()) - (errs ())) + (failures ()) + (errs ())) (unwind-protect-if handle-errors - (handler-case-if handle-errors - (let ((res (progn (setup test) - (apply (test-thunk test) (list test))))) - (if (typep res 'test-failure) - (setf failures (cons res failures)))) - (test-failure (failure) - (setf failures (cons failure failures))) - (t (err) - (setf errs (cons err errs)))) + (handler-case-if handle-errors + (let ((res (progn (setup test) + (apply (test-thunk test) (list test))))) + (if (typep res 'test-failure) + (setf failures (cons res failures)))) + (test-failure (failure) + (setf failures (cons failure failures))) + (t (err) + (setf errs (cons err errs)))) (handler-case-if handle-errors (teardown test) (t (err) - (setf errs (cons err errs))))) + (setf errs (cons err errs))))) (make-instance 'test-result - :test test - :start-time start-time - :stop-time (get-universal-time) - :failures failures - :errors errs))) + :test test + :start-time start-time + :stop-time (get-universal-time) + :failures failures + :errors errs))) (defmacro def-test-fixture (name supers slotdefs &rest class-options) "Define a new test-fixture class. Works just like defclass, but @@ -138,23 +138,23 @@ ensure that test-fixture is a super." ,slotdefs ,@class-options)) (defmacro make-test-case (name fixture &key - (test-thunk 'perform-test) - (test-suite nil) - (description "No description.")) + (test-thunk 'perform-test) + (test-suite nil) + (description "No description.")) "Create a test-case which is an instance of FIXTURE. TEST-THUNK is 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 (gensym "new-test"))) `(let ((,newtest (make-instance ,fixture - :test-name ,name - :test-thunk ,(if (eq test-thunk 'perform-test) - ''perform-test - test-thunk) - :description ,description))) + :test-name ,name + :test-thunk ,(if (eq test-thunk 'perform-test) + ''perform-test + test-thunk) + :description ,description))) (if ,test-suite (add-test ,newtest ,test-suite)) ,newtest))) - + (defclass test-suite () ((name :initarg :name @@ -171,23 +171,23 @@ instance. DESCRIPTION is obviously what it says it is." (defmethod tests ((suite test-suite)) (let ((tlist nil)) (maphash #'(lambda (k v) - (declare (ignore k)) - (setf tlist (cons v tlist))) - (tests-hash suite)) + (declare (ignore k)) + (setf tlist (cons v tlist))) + (tests-hash suite)) (reverse tlist))) (defmacro make-test-suite (name description &rest testspecs) "Returns a new test-suite. TESTSPECS are just like lists of arguments to MAKE-TEST-CASE." (let* ((newsuite (gensym "test-suite")) - (testforms (mapcar #'(lambda (spec) - (list - 'add-test - (cons 'make-test-case spec) - newsuite)) - testspecs))) + (testforms (mapcar #'(lambda (spec) + (list + 'add-test + (cons 'make-test-case spec) + newsuite)) + testspecs))) `(let ((,newsuite (make-instance 'test-suite :name ,name - :description ,description))) + :description ,description))) ,@testforms ,newsuite))) @@ -250,27 +250,27 @@ standard-output. If VERBOSE is non-nil then will produce a lengthy and informative report, otherwise just prints wether the test passed or failed or errored out." (if verbose (format stream - "------------------------------------------------------~%")) + "------------------------------------------------------~%")) (format stream "Test ~A ~A ~%" - (test-name (result-test result)) - (cond - ((test-failures result) "Failed") - ((test-errors result) "Errored") - (t "Passed"))) + (test-name (result-test result)) + (cond + ((test-failures result) "Failed") + ((test-errors result) "Errored") + (t "Passed"))) (if verbose (progn - (format stream "Description: ~A~%" (description (result-test result))) - (if (test-failures result) - (progn - (format stream "Failures:~%") - (mapcar #'(lambda (fail) (format stream " ~A" fail)) - (test-failures result)))) - (if (test-errors result) - (progn - (format stream "Errors:~%") - (mapcar #'(lambda (fail) (format stream " ~A" fail)) - (test-errors result)))))) - ;(format stream "~%~%") ; debian bug #190398 + (format stream "Description: ~A~%" (description (result-test result))) + (if (test-failures result) + (progn + (format stream "Failures:~%") + (mapcar #'(lambda (fail) (format stream " ~A" fail)) + (test-failures result)))) + (if (test-errors result) + (progn + (format stream "Errors:~%") + (mapcar #'(lambda (fail) (format stream " ~A" fail)) + (test-errors result)))))) + ;(format stream "~%~%") ; debian bug #190398 ) (defmethod report-result ((results list) &key (stream t) (verbose nil)) -- 2.34.1