anchor.diff:  
   (defgeneric map-test-suites (function)
     (:method (function)
  -    (map-tests (coerce function 'function) suite))
  +    (map-test-suites (coerce function 'function)))
     (:method ((function function))
  -    (map-objects fn (find-class 'test-suite))))
  +    (map-objects function (find-class 'test-suite))))
   
   
   (defgeneric add-test (test suite)
     (:method ((test test) (suite test-suite))
  -    (register-object test suite)))
  +    (with-lock-held ((%test-suite-test-lock suite)) 
  +      (register-object test suite))))
   
   (defgeneric remove-test (test suite)
     (:method ((test test) (suite test-suite))
  -    (remove-object test suite)))
  +    (with-lock-held ((%test-suite-test-lock suite)) 
  +      (remove-object test suite))))
   
   (defgeneric find-test (name suite &optional errorp)
     (:method ((name symbol) (suite test-suite) &optional (errorp t))
  -    (find-object name suite errorp)))
  +    (with-lock-held ((%test-suite-test-lock suite)) 
  +      (find-object name suite errorp))))
   
   (defgeneric map-tests (function suite)
     (:method (function (suite test-suite))
  -    (map-objects function suite)))
  +    (with-lock-held ((%test-suite-test-lock suite)) 
  +      (map-objects function suite))))
  
positive.code:   (declare (ignore print-name print-label))
    (let (args-changedp)
      (when namep
        (unless (or pnp (slot-boundp instance 'utils::print-name))
          (setf args-changedp t
                (getf initargs :print-name)
                (symbol-name name)))
        (unless (or plp (slot-boundp instance 'utils::print-label))
          (setf args-changedp t
                (getf initargs :print-label)
                (symbol-name name))))
      (cond
        (args-changedp (apply #'call-next-method instance slot-names initargs))
        (t (call-next-metod)))))
  
  (defmethod print-label ((object test-suite) (stream stream))
    (let ((name (ignore-errors (object-name object)))
  
negative.code: 
  
  (defgeneric %test-suite-tests (suite))
  (defgeneric %test-suite-test-lock (suite))
  
  (defgeneric test-suite-default-test-class (suite))
  (defgeneric (setf test-suite-default-test-class) (new-value suite))
  