X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcheck.lisp;h=9b7ad636e5794a9bdb027d71376676b6f8f2461e;hb=f3f10e21f646bddb8c1817e496be199afc65b648;hp=efac176356e8e42b3d1800c418b7a4b780846291;hpb=55740edc3e2b3444e7e17978f68df8eced2b19e7;p=fiveam.git

diff --git a/src/check.lisp b/src/check.lisp
index efac176..9b7ad63 100644
--- a/src/check.lisp
+++ b/src/check.lisp
@@ -1,4 +1,4 @@
-;; -*- lisp -*-
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
 
 (in-package :it.bese.fiveam)
 
@@ -36,7 +36,7 @@
    (test-case :accessor test-case :initarg :test-case)
    (test-expr :accessor test-expr :initarg :test-expr))
   (:documentation "All checking macros will generate an object of
- type TEST-RESULT."))
+type TEST-RESULT."))
 
 (defclass test-passed (test-result)
   ()
@@ -91,8 +91,8 @@ when appropiate."))
 
 (defun add-result (result-type &rest make-instance-args)
   "Create a TEST-RESULT object of type RESULT-TYPE passing it the
-  initialize args MAKE-INSTANCE-ARGS and adds the resulting
-  object to the list of test results."
+initialize args MAKE-INSTANCE-ARGS and adds the resulting object to
+the list of test results."
   (with-run-state (result-list current-test)
     (let ((result (apply #'make-instance result-type
                          (append make-instance-args (list :test-case current-test)))))
@@ -114,20 +114,19 @@ If TEST returns a true value a test-passed result is generated,
 otherwise a test-failure result is generated. The reason, unless
 REASON-ARGS is provided, is generated based on the form of TEST:
 
- (predicate expected actual) - Means that we want to check
- whether, according to PREDICATE, the ACTUAL value is
- in fact what we EXPECTED.
+\(predicate expected actual) - Means that we want to check whether,
+according to PREDICATE, the ACTUAL value is in fact what we EXPECTED.
 
- (predicate value) - Means that we want to ensure that VALUE
- satisfies PREDICATE.
+\(predicate value) - Means that we want to ensure that VALUE satisfies
+PREDICATE.
 
- Wrapping the TEST form in a NOT simply preducse a negated reason
- string."
+Wrapping the TEST form in a NOT simply produces a negated reason
+string."
   (assert (listp test)
           (test)
           "Argument to IS must be a list, not ~S" test)
   (let (bindings effective-test default-reason-args)
-    (with-unique-names (e a v)
+    (with-gensyms (e a v)
       (flet ((process-entry (predicate expected actual &optional negatedp)
                ;; make sure EXPECTED is holding the entry that starts with 'values
                (when (and (consp actual)
@@ -135,9 +134,7 @@ REASON-ARGS is provided, is generated based on the form of TEST:
                  (assert (not (and (consp expected)
                                    (eq (car expected) 'values))) ()
                                    "Both the expected and actual part is a values expression.")
-                 (let ((tmp expected))
-                   (setf expected actual
-                         actual tmp)))
+                 (rotatef expected actual))
                (let ((setf-forms))
                  (if (and (consp expected)
                           (eq (car expected) 'values))
@@ -162,29 +159,29 @@ REASON-ARGS is provided, is generated based on the form of TEST:
           ((not (?predicate ?expected ?actual))
            (process-entry ?predicate ?expected ?actual t)
            (setf default-reason-args
-                 (list "~S evaluated to ~S, which is ~S to ~S (it should not be)"
+                 (list "~2&~S~2% evaluated to ~2&~S~2% which is ~2&~S~2%to ~2&~S~2% (it should not be)"
                        `',?actual a `',?predicate e)))
           ((not (?satisfies ?value))
            (setf bindings (list (list v ?value))
                  effective-test `(not (,?satisfies ,v))
                  default-reason-args
-                 (list "~S evaluated to ~S, which satisfies ~S (it should not)"
+                 (list "~2&~S~2% evaluated to ~2&~S~2% which satisfies ~2&~S~2% (it should not)"
                        `',?value v `',?satisfies)))
           ((?predicate ?expected ?actual)
            (process-entry ?predicate ?expected ?actual)
            (setf default-reason-args
-                 (list "~S evaluated to ~S, which is not ~S to ~S."
+                 (list "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2% to ~2&~S~2%."
                        `',?actual a `',?predicate e)))
           ((?satisfies ?value)
            (setf bindings (list (list v ?value))
                  effective-test `(,?satisfies ,v)
                  default-reason-args
-                 (list "~S evaluated to ~S, which does not satisfy ~S"
+                 (list "~2&~S~2% evaluated to ~2&~S~2% which does not satisfy ~2&~S~2%"
                        `',?value v `',?satisfies)))
           (?_
            (setf bindings '()
                  effective-test test
-                 default-reason-args (list "~S was NIL." `',test)))))
+                 default-reason-args (list "~2&~S~2% was NIL." `',test)))))
       `(let ,bindings
          (if ,effective-test
              (add-result 'test-passed :test-expr ',test)
@@ -229,8 +226,8 @@ REASON-ARGS is provided, is generated based on the form of TEST:
   failure otherwise. Like IS-TRUE, and unlike IS, IS-FALSE does
   not inspect CONDITION to determine what reason to give it case
   of test failure"
-  
-  (with-unique-names (value)
+
+  (with-gensyms (value)
     `(let ((,value ,condition))
        (if ,value
            (process-failure