112 |
(initforms |
(initforms |
113 |
(loop for slot-option in slot-options |
(loop for slot-option in slot-options |
114 |
collect (collect-properties slot-option :initform))) |
collect (collect-properties slot-option :initform))) |
115 |
|
(class-var-name |
116 |
|
(intern (concatenate 'string "*CLASS-" (symbol-name class-name) |
117 |
|
"-RETURNED-BY-DEFCLASS*") |
118 |
|
(find-package :cl-test))) |
119 |
) |
) |
120 |
|
|
121 |
(declare (ignorable readers writers accessors allocations |
(declare (ignorable readers writers accessors allocations |
165 |
(setf (gethash class-name *my-classes*) my-class-obj)) |
(setf (gethash class-name *my-classes*) my-class-obj)) |
166 |
|
|
167 |
`(progn |
`(progn |
168 |
|
(declaim (special ,class-var-name)) |
169 |
|
|
170 |
(eval-when (load eval compile) |
(eval-when (load eval compile) |
171 |
(ignore-errors (defclass ,@(cdr args)))) |
(ignore-errors (setq ,class-var-name (defclass ,@(cdr args))))) |
172 |
|
|
173 |
|
(deftest ,(make-defclass-test-name class-name "-DEFCLASS-RETURNS-CLASS") |
174 |
|
(eqt (find-class ',class-name) ,class-var-name) |
175 |
|
t) |
176 |
|
|
177 |
(deftest ,(make-defclass-test-name class-name |
(deftest ,(make-defclass-test-name class-name |
178 |
"-IS-IN-ITS-METACLASS") |
"-IS-IN-ITS-METACLASS") |