anchor.diff:    (defsuite geometry-test-suite-1
         (:class test-suite))
     
  -  (deftest radians-to-degrees-1 geometry-test-suite-1
  +  (deftest radians-to-degrees-1 (geometry-test-suite-1)
       (:object #'radians-to-degrees)
       (:summary "Ensure...")
  -    (:setup-lamba ()) ;; no-op
  -    (:cleanup-lamba ()) ;; no-op    
  +    ;; (:setup-lamba ()) ;; no-op
  +    ;; (:cleanup-lamba ()) ;; no-op    
       (:lambda (theta)
         (radians-to-degrees theta)))
   
  
positive.code:          (do-recorded-test ,record *standard-output*))))))
                      
  
  
  (defmacro defsuite (name &rest properties
                             &aux (default-class 'test-suite)
                               (default-test-class 'lisp-test))
    (let ((p (copy-list properties)))
      (labels ((format-spec (spec)
                 (destructuring-bind (name . value) spec
                   (declare (ignore name))
                   (cond
                     ((cdr value) (values value))
                     (t (values (car value))))))
               (find-spec (name &optional default)
                 (let ((spec (assoc name p :test #'eq)))
                   (cond 
                     (spec (setf p (delete spec p :test #'eq))
                           (values (format-spec spec) t))
                     (t (values default nil)))))
               (format-properties ()
                 (mapcan (lambda (spec)
                           (multiple-value-bind (name . value) spec
                             (cond
                               ((cdr value) spec)
                               (t (list name (car value))))))
                         p)))
        (with-gensym (class instance dtc)
          `(let* ((,class (quote ,(find-spec :class (find-class default-class))))
                  ;; note that all initarg values except for :CLASS, :NAME,
                  ;; :DEFAULT-TEST-CLASS  will be evaluated
                  ;; (FIXME: This is "cheap")
                  (,dtc (quote ,(find-spec :default-test-class 
                                           (find-class default-test-class))))
                  (,instance (make-instance ,class 
                                            :name (quote ,name)
                                            :default-test-class ,dtc
                                            ,@(format-properties))))
             (register-test-suite ,instance)
             (values ,instance))))))
  
  
  ;; (defsuite foo-suite)
  
negative.code: ;; (defsuite foo-suite (:class foo-test-suite))
  
  
  ;;; *TEST-SUITE*
  
  (declaim (type test-suite *test-suite*))
  (defvar *test-suite*)
  (setf (documentation '*test-suite* 'variable)
        "Default test suite, within the active lexical environment.
  
  See also: 
  