anchor.diff:  ;;; This test is pretty crude. The correct thing to do would be to
   ;;; parse the output, extract the implementation-dependant stuff,
   ;;; and verify the rest. This would be painful without CL-PPCRE.
  +#+nil
   (test object-printing
     (with-output-to-string (*standard-output*)
  -    (5am:finishes (print (cons-std-object)))
  -    (5am:finishes (print (add-parent (cons-std-object) (cons-std-object))))))
  +    (5am:finishes (print (std-allocate-object =standard-metaobject=)))
  +    (5am:finishes (print (add-parent (std-allocate-object =standard-metaobject=) (std-allocate-object =standard-metaobject=))))))
   
   ;;;
   ;;; Allocation
  
positive.code:   (is (equal '(bar foo) (push 'bar (%object-roles object))))
    (is (equal '(bar foo) (%object-roles object))))
  
  #+nil
  (test (%object-hierarchy-cache :fixture with-std-object)
    (is (equal (list object) (%object-hierarchy-cache object)))
    (is (equal '(foo) (setf (%object-hierarchy-cache object) '(foo))))
    (is (equal '(foo) (%object-hierarchy-cache object)))
    (is (equal '(bar foo) (push 'bar (%object-hierarchy-cache object))))
    (is (equal '(bar foo) (%object-hierarchy-cache object))))
  
  #+nil
  (test (%object-children :fixture with-std-object)
    (is (null (%object-children object)))
    (is (equal '(foo) (setf (%object-children object) '(foo))))
    (is (equal '(foo) (%object-children object)))
    (is (equal '(bar foo) (push 'bar (%object-children object))))
    (is (equal '(bar foo) (%object-children object))))
  
  (def-suite interface-accessors :in objects)
  (in-suite interface-accessors)
  
  (test (object-metaobject :fixture with-std-object)
    (is (eql =standard-metaobject= (object-metaobject object)))
    (is (null (fboundp '(setf object-metaobject)))))
  
  #+nil
  (test (object-parents :fixture with-std-object)
    (is (null (object-parents object)))
    (setf (%object-parents object) '(foo))
    (is (equal '(foo) (object-parents object)))
    (push 'bar (%object-parents object))
    (is (equal '(bar foo) (object-parents object)))
    (is (null (fboundp '(setf object-parents)))))
  
  (def-suite inheritance :in objects)
  (def-suite inheritance-basic :in inheritance)
  
negative.code:     (is (not (parentp c b)))))
  
  (test childp
    (let ((a (std-allocate-object =standard-metaobject=))
          (b (std-allocate-object =standard-metaobject=))
          (c (std-allocate-object =standard-metaobject=)))
      (add-parent a b)
      (add-parent b c)
      (is (childp b a))
  