107 |
(notnot-mv methods)))) |
(notnot-mv methods)))) |
108 |
(%m)) |
(%m)) |
109 |
t) |
t) |
110 |
|
|
111 |
|
;;; User-defined methods |
112 |
|
|
113 |
|
(defclass make-load-form-class-04 () |
114 |
|
((a :initarg :a) (b :initarg :b) (c :initarg :c))) |
115 |
|
|
116 |
|
(defmethod make-load-form ((obj make-load-form-class-04) |
117 |
|
&optional (env t)) |
118 |
|
(declare (ignore env)) |
119 |
|
(let ((newobj (gensym))) |
120 |
|
`(let ((,newobj (allocate-instance (find-class 'make-load-form-class-04)))) |
121 |
|
,@(loop for slot-name in '(a b c) |
122 |
|
when (slot-boundp obj slot-name) |
123 |
|
collect `(setf (slot-value ,newobj ',slot-name) |
124 |
|
',(slot-value obj slot-name))) |
125 |
|
,newobj))) |
126 |
|
|
127 |
|
(deftest make-load-form.13 |
128 |
|
(let* ((obj (make-instance 'make-load-form-class-04)) |
129 |
|
(obj2 (eval (make-load-form obj)))) |
130 |
|
(values |
131 |
|
(eqt (class-of obj2) (class-of obj)) |
132 |
|
(map-slot-boundp* obj2 '(a b c)))) |
133 |
|
t (nil nil nil)) |
134 |
|
|
135 |
|
(deftest make-load-form.14 |
136 |
|
(let* ((obj (make-instance 'make-load-form-class-04 :a 1 :b '(a b c) :c 'a)) |
137 |
|
(obj2 (eval (make-load-form obj)))) |
138 |
|
(values |
139 |
|
(eqt (class-of obj2) (class-of obj)) |
140 |
|
(map-slot-boundp* obj2 '(a b c)) |
141 |
|
(map-slot-value obj2 '(a b c)))) |
142 |
|
t |
143 |
|
(t t t) |
144 |
|
(1 (a b c) a)) |
145 |
|
|
146 |
|
(deftest make-load-form.15 |
147 |
|
(let* ((obj (make-instance 'make-load-form-class-04 :b '(a b c) :c 'a)) |
148 |
|
(obj2 (eval (make-load-form obj nil)))) |
149 |
|
(values |
150 |
|
(eqt (class-of obj2) (class-of obj)) |
151 |
|
(map-slot-boundp* obj2 '(a b c)) |
152 |
|
(map-slot-value obj2 '(b c)))) |
153 |
|
t |
154 |
|
(nil t t) |
155 |
|
((a b c) a)) |
156 |
|
|
157 |
|
;;; Additional tests will be in the files testing file compilation |