From c8ae1c4c43c837564b44d8a967615313ca085a07 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Wed, 15 Jun 2005 01:19:03 +0000
Subject: [PATCH] Added more tests on classes of objects un *universe*. 
 Inspired by a bug found by Bruno Haible in cmucl

---
 ansi-tests/types-and-class.lsp | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

diff --git a/ansi-tests/types-and-class.lsp b/ansi-tests/types-and-class.lsp
index 42220357..7fa8fc01 100644
--- a/ansi-tests/types-and-class.lsp
+++ b/ansi-tests/types-and-class.lsp
@@ -164,6 +164,14 @@
        append (check-equivalence sym class))
   nil)
 
+(deftest all-classes-are-type-equivalent-to-their-names.2
+  (loop for x in *universe*
+	for cl = (class-of x)
+	for name = (class-name cl)
+	when name
+	append (check-equivalence name cl))
+  nil)
+
 ;;; Check that all class names in CL that name standard-classes or
 ;;; structure-classes are subtypes of standard-object and structure-object,
 ;;; respectively
@@ -178,6 +186,14 @@
 	collect sym)
   nil)
 
+(deftest all-standard-classes-are-subtypes-of-standard-object.2
+  (loop for x in *universe*
+	for class = (class-of x)
+	when (and (typep class 'standard-class)
+		  (not (subtypep class 'standard-object)))
+	collect x)
+  nil)
+
 (deftest all-structure-classes-are-subtypes-of-structure-object
   (loop for sym being the external-symbols of "COMMON-LISP"
 	for class = (find-class sym nil)
@@ -187,6 +203,14 @@
 		      (not (subtypep class 'structure-object))))
 	collect sym)
   nil)
+
+(deftest all-structure-classes-are-subtypes-of-structure-object.2
+  (loop for x in *universe*
+	for cl = (class-of x)
+	when (and (typep cl 'structure-class)
+		  (not (subtypep cl 'structure-object)))
+	collect x)
+  nil)
 		  
 ;;; Confirm that only the symbols exported from CL that are supposed
 ;;; to be types are actually classes (see section 11.1.2.1.1)
-- 
GitLab