mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-25 14:01:07 -08:00
Code Issues Projects Releases Packages Wiki Activity

check-direct-superclasses: handle forward-referenced-class

Browse source 
The forward-referenced-class metaclass has no superclasses.

Moreover:

- check superclasses after they are added (removes one fixme)
- don't map validate-superclass during clos booting
This commit is contained in:
Daniel Kochmański 2020-12-31 20:52:14 +01:00
parent 178e0362e3
commit 086ec59ab8
1 changed files with 23 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

41
src/clos/standard.lsp
View file

@ -239,24 +239,29 @@
(remove child (class-direct-subclasses parent))))
(defun check-direct-superclasses (class supplied-superclasses)
(if supplied-superclasses
(loop for superclass in supplied-superclasses
;; Until we process streams.lsp there are some invalid combinations
;; using built-in-class, which here we simply ignore.
unless (or (validate-superclass class superclass)
(not (eq *clos-booted* T)))
do (error "Class ~A is not a valid superclass for ~A" superclass class))
(setf supplied-superclasses
(list (find-class (typecase class
(STANDARD-CLASS 'STANDARD-OBJECT)
(STRUCTURE-CLASS 'STRUCTURE-OBJECT)
(FUNCALLABLE-STANDARD-CLASS 'FUNCALLABLE-STANDARD-OBJECT)
(otherwise (error "No :DIRECT-SUPERCLASS ~
argument was supplied for metaclass ~S." (class-of class))))))))
;; FIXME!!! Here should come the invocation of VALIDATE-SUPERCLASS!
;; FIXME!!! We should check that structures and standard objects are
;; not mixed, and that STANDARD-CLASS, or STANDARD-GENERIC-FUNCTION,
;; etc, are the first classes.
(unless supplied-superclasses
(setf supplied-superclasses
(typecase class
(standard-class
(list (find-class 'standard-object)))
(structure-class
(list (find-class 'structure-object)))
(funcallable-standard-class
(list (find-class 'funcallable-standard-object)))
(forward-referenced-class
nil)
(otherwise
(error "No :DIRECT-SUPERCLASS argument was supplied for the ~
metaclass ~S." (class-of class))))))
;; Until we process streams.lsp there are some invalid combinations using
;; built-in-class, which here we simply ignore.
(when (eq *clos-booted* T)
(loop for superclass in supplied-superclasses
unless (validate-superclass class superclass)
do (error "Class ~A is not a valid superclass for ~A" superclass class)))
;; FIXME!!! We should check that structures and standard objects are not
;; mixed, and that STANDARD-CLASS, or STANDARD-GENERIC-FUNCTION, etc, are
;; the first classes.
supplied-superclasses)
(defmethod validate-superclass ((class class) (superclass class))