Skip to content
Snippets Groups Projects
Commit c8ae1c4c authored by pfdietz's avatar pfdietz
Browse files

Added more tests on classes of objects un *universe*. Inspired by a bug found...

Added more tests on classes of objects un *universe*.  Inspired by a bug found by Bruno Haible in cmucl
parent c1f64e96
No related branches found
No related tags found
No related merge requests found
......@@ -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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment