23 |
(progn |
(progn |
24 |
(eval '(defmethod dmc-long-gf-01 ((x t) (y t)) :foo)) |
(eval '(defmethod dmc-long-gf-01 ((x t) (y t)) :foo)) |
25 |
(handler-case |
(handler-case |
26 |
(dmc-long-gf-01 'a 'b) |
(eval '(dmc-long-gf-01 'a 'b)) |
27 |
(error () :caught))) |
(error () :caught))) |
28 |
:caught) |
:caught) |
29 |
|
|
30 |
|
;;; A single method group with the * method group specifier |
31 |
|
|
32 |
|
(eval-when (:load-toplevel :compile-toplevel :execute) |
33 |
|
(report-and-ignore-errors |
34 |
|
(defparameter *dmc-long-02* |
35 |
|
(define-method-combination mc-long-02 nil ((method-list *)) |
36 |
|
`(vector ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) |
37 |
|
(report-and-ignore-errors |
38 |
|
(defgeneric dmc-long-gf-02 (x y) (:method-combination mc-long-02))) |
39 |
|
) |
40 |
|
|
41 |
|
(deftest define-method-combination-long.02.1 |
42 |
|
(eqt *dmc-long-02* 'mc-long-02) |
43 |
|
t) |
44 |
|
|
45 |
|
(deftest define-method-combination-long.02.2 |
46 |
|
(progn |
47 |
|
(eval '(defmethod dmc-long-gf-02 ((x (eql 1)) (y integer)) 'a)) |
48 |
|
(eval '(defmethod dmc-long-gf-02 ((x integer) (y (eql 2))) 'b)) |
49 |
|
(eval '(defmethod dmc-long-gf-02 ((x integer) (y integer)) 'z)) |
50 |
|
(values |
51 |
|
(dmc-long-gf-02 0 0) |
52 |
|
(dmc-long-gf-02 1 0) |
53 |
|
(dmc-long-gf-02 0 2) |
54 |
|
(dmc-long-gf-02 1 2))) |
55 |
|
#(z) #(a z) #(b z) #(a b z)) |
56 |
|
|
57 |
|
(deftest define-method-combination-long.02.3 |
58 |
|
(signals-error (dmc-long-gf-02 nil nil) error) |
59 |
|
t) |
60 |
|
|
61 |
|
;;; Same, but with :order parameter. |
62 |
|
;;; Also, :description with a format string |
63 |
|
|
64 |
|
(eval-when (:load-toplevel :compile-toplevel :execute) |
65 |
|
(report-and-ignore-errors |
66 |
|
(defparameter *dmc-long-03* |
67 |
|
(define-method-combination mc-long-03 nil ((method-list * :order :most-specific-first |
68 |
|
:description "This method has qualifiers ~A" |
69 |
|
)) |
70 |
|
`(vector ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) |
71 |
|
(report-and-ignore-errors |
72 |
|
(defgeneric dmc-long-gf-03 (x y) (:method-combination mc-long-03))) |
73 |
|
) |
74 |
|
|
75 |
|
(deftest define-method-combination-long.03.1 |
76 |
|
(eqt *dmc-long-03* 'mc-long-03) |
77 |
|
t) |
78 |
|
|
79 |
|
(deftest define-method-combination-long.03.2 |
80 |
|
(progn |
81 |
|
(eval '(defmethod dmc-long-gf-03 ((x (eql 1)) (y integer)) 'a)) |
82 |
|
(eval '(defmethod dmc-long-gf-03 ((x integer) (y (eql 2))) 'b)) |
83 |
|
(eval '(defmethod dmc-long-gf-03 ((x integer) (y integer)) 'z)) |
84 |
|
(values |
85 |
|
(dmc-long-gf-03 0 0) |
86 |
|
(dmc-long-gf-03 1 0) |
87 |
|
(dmc-long-gf-03 0 2) |
88 |
|
(dmc-long-gf-03 1 2))) |
89 |
|
#(z) #(a z) #(b z) #(a b z)) |
90 |
|
|
91 |
|
(deftest define-method-combination-long.03.3 |
92 |
|
(signals-error (dmc-long-gf-03 nil nil) error) |
93 |
|
t) |
94 |
|
|
95 |
|
;;; Same, but with :order parameter :most-specific-last |
96 |
|
;;; (and testing that the :order parameter is evaluated) |
97 |
|
|
98 |
|
(eval-when (:load-toplevel :compile-toplevel :execute) |
99 |
|
(report-and-ignore-errors |
100 |
|
(defparameter *dmc-long-04* |
101 |
|
(let ((order :most-specific-last)) |
102 |
|
(define-method-combination mc-long-04 nil ((method-list * :order order)) |
103 |
|
`(vector ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list)))))) |
104 |
|
(report-and-ignore-errors |
105 |
|
(defgeneric dmc-long-gf-04 (x y) (:method-combination mc-long-04))) |
106 |
|
) |
107 |
|
|
108 |
|
(deftest define-method-combination-long.04.1 |
109 |
|
(eqt *dmc-long-04* 'mc-long-04) |
110 |
|
t) |
111 |
|
|
112 |
|
(deftest define-method-combination-long.04.2 |
113 |
|
(progn |
114 |
|
(eval '(defmethod dmc-long-gf-04 ((x (eql 1)) (y integer)) 'a)) |
115 |
|
(eval '(defmethod dmc-long-gf-04 ((x integer) (y (eql 2))) 'b)) |
116 |
|
(eval '(defmethod dmc-long-gf-04 ((x integer) (y integer)) 'z)) |
117 |
|
(values |
118 |
|
(dmc-long-gf-04 0 0) |
119 |
|
(dmc-long-gf-04 1 0) |
120 |
|
(dmc-long-gf-04 0 2) |
121 |
|
(dmc-long-gf-04 1 2))) |
122 |
|
#(z) #(z a) #(z b) #(z b a)) |
123 |
|
|
124 |
|
(deftest define-method-combination-long.04.3 |
125 |
|
(signals-error (dmc-long-gf-04 nil nil) error) |
126 |
|
t) |
127 |
|
|
128 |
|
;;; Empty qualifier list |
129 |
|
|
130 |
|
(eval-when (:load-toplevel :compile-toplevel :execute) |
131 |
|
(report-and-ignore-errors |
132 |
|
(defparameter *dmc-long-05* |
133 |
|
(define-method-combination mc-long-05 nil ((method-list nil) |
134 |
|
(ignored-methods *)) |
135 |
|
(declare (ignorable ignored-methods)) |
136 |
|
`(vector ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) |
137 |
|
(report-and-ignore-errors |
138 |
|
(defgeneric dmc-long-gf-05 (x y) (:method-combination mc-long-05))) |
139 |
|
) |
140 |
|
|
141 |
|
(deftest define-method-combination-long.05.1 |
142 |
|
(eqt *dmc-long-05* 'mc-long-05) |
143 |
|
t) |
144 |
|
|
145 |
|
(deftest define-method-combination-long.05.2 |
146 |
|
(progn |
147 |
|
(eval '(defmethod dmc-long-gf-05 ((x (eql 1)) (y integer)) 'a)) |
148 |
|
(eval '(defmethod dmc-long-gf-05 ((x integer) (y (eql 2))) 'b)) |
149 |
|
(eval '(defmethod dmc-long-gf-05 ((x integer) (y integer)) 'z)) |
150 |
|
(eval '(defmethod dmc-long-gf-05 foo ((x t) (y t)) 'bad)) |
151 |
|
(values |
152 |
|
(dmc-long-gf-05 nil nil) |
153 |
|
(dmc-long-gf-05 0 0) |
154 |
|
(dmc-long-gf-05 1 0) |
155 |
|
(dmc-long-gf-05 0 2) |
156 |
|
(dmc-long-gf-05 1 2))) |
157 |
|
#() #(z) #(a z) #(b z) #(a b z)) |
158 |
|
|
159 |
|
;;; :required |
160 |
|
|
161 |
|
(eval-when (:load-toplevel :compile-toplevel :execute) |
162 |
|
(report-and-ignore-errors |
163 |
|
(defparameter *dmc-long-06* |
164 |
|
(define-method-combination mc-long-06 nil ((method-list nil :required t) |
165 |
|
(ignored-methods *)) |
166 |
|
(declare (ignorable ignored-methods)) |
167 |
|
`(vector ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) |
168 |
|
(report-and-ignore-errors |
169 |
|
(defgeneric dmc-long-gf-06 (x y) (:method-combination mc-long-06))) |
170 |
|
) |
171 |
|
|
172 |
|
(deftest define-method-combination-long.06.1 |
173 |
|
(eqt *dmc-long-06* 'mc-long-06) |
174 |
|
t) |
175 |
|
|
176 |
|
(deftest define-method-combination-long.06.2 |
177 |
|
(progn |
178 |
|
(eval '(defmethod dmc-long-gf-06 ((x (eql 1)) (y integer)) 'a)) |
179 |
|
(eval '(defmethod dmc-long-gf-06 ((x integer) (y (eql 2))) 'b)) |
180 |
|
(eval '(defmethod dmc-long-gf-06 ((x integer) (y integer)) 'z)) |
181 |
|
(eval '(defmethod dmc-long-gf-06 foo ((x t) (y t)) 'bad)) |
182 |
|
(values |
183 |
|
(dmc-long-gf-06 0 0) |
184 |
|
(dmc-long-gf-06 1 0) |
185 |
|
(dmc-long-gf-06 0 2) |
186 |
|
(dmc-long-gf-06 1 2))) |
187 |
|
#(z) #(a z) #(b z) #(a b z)) |
188 |
|
|
189 |
|
(deftest define-method-combination-long.06.3 |
190 |
|
(signals-error-always (dmc-long-gf-06 nil nil) error) |
191 |
|
t t) |
192 |
|
|
193 |
|
|
194 |
|
;;; Non-empty lambda lists |
195 |
|
|
196 |
|
(eval-when (:load-toplevel :compile-toplevel :execute) |
197 |
|
(report-and-ignore-errors |
198 |
|
(defparameter *dmc-long-07* |
199 |
|
(define-method-combination mc-long-07 (p1 p2) ((method-list *)) |
200 |
|
`(vector ',p1 ',p2 ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) |
201 |
|
(report-and-ignore-errors |
202 |
|
(defgeneric dmc-long-gf-07 (x y) (:method-combination mc-long-07 1 2))) |
203 |
|
) |
204 |
|
|
205 |
|
(deftest define-method-combination-long.07.1 |
206 |
|
(eqt *dmc-long-07* 'mc-long-07) |
207 |
|
t) |
208 |
|
|
209 |
|
(deftest define-method-combination-long.07.2 |
210 |
|
(progn |
211 |
|
(eval '(defmethod dmc-long-gf-07 ((x (eql 1)) (y integer)) 'a)) |
212 |
|
(eval '(defmethod dmc-long-gf-07 ((x integer) (y (eql 2))) 'b)) |
213 |
|
(eval '(defmethod dmc-long-gf-07 ((x integer) (y integer)) 'z)) |
214 |
|
(values |
215 |
|
(dmc-long-gf-07 0 0) |
216 |
|
(dmc-long-gf-07 1 0) |
217 |
|
(dmc-long-gf-07 0 2) |
218 |
|
(dmc-long-gf-07 1 2))) |
219 |
|
#(1 2 z) #(1 2 a z) #(1 2 b z) #(1 2 a b z)) |
220 |
|
|
221 |
|
(deftest define-method-combination-long.07.3 |
222 |
|
(signals-error (dmc-long-gf-07 nil) error) |
223 |
|
t) |
224 |
|
|
225 |
|
(eval-when (:load-toplevel :compile-toplevel :execute) |
226 |
|
(report-and-ignore-errors |
227 |
|
(defparameter *dmc-long-08* |
228 |
|
(define-method-combination mc-long-08 (p1 &optional p2 p3) ((method-list *)) |
229 |
|
`(vector ',p1 ',p2 ',p3 ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) |
230 |
|
(report-and-ignore-errors |
231 |
|
(defgeneric dmc-long-gf-08 (x y) (:method-combination mc-long-08 1 2))) |
232 |
|
) |
233 |
|
|
234 |
|
(deftest define-method-combination-long.08.1 |
235 |
|
(eqt *dmc-long-08* 'mc-long-08) |
236 |
|
t) |
237 |
|
|
238 |
|
(deftest define-method-combination-long.08.2 |
239 |
|
(progn |
240 |
|
(eval '(defmethod dmc-long-gf-08 ((x (eql 1)) (y integer)) 'a)) |
241 |
|
(eval '(defmethod dmc-long-gf-08 ((x integer) (y (eql 2))) 'b)) |
242 |
|
(eval '(defmethod dmc-long-gf-08 ((x integer) (y integer)) 'z)) |
243 |
|
(values |
244 |
|
(dmc-long-gf-08 0 0) |
245 |
|
(dmc-long-gf-08 1 0) |
246 |
|
(dmc-long-gf-08 0 2) |
247 |
|
(dmc-long-gf-08 1 2))) |
248 |
|
#(1 2 nil z) #(1 2 nil a z) #(1 2 nil b z) #(1 2 nil a b z)) |
249 |
|
|
250 |
|
(deftest define-method-combination-long.08.3 |
251 |
|
(signals-error (dmc-long-gf-08 nil) error) |
252 |
|
t) |
253 |
|
|
254 |
|
(eval-when (:load-toplevel :compile-toplevel :execute) |
255 |
|
(report-and-ignore-errors |
256 |
|
(defparameter *dmc-long-09* |
257 |
|
(define-method-combination mc-long-09 (p1 &key p2 p3) ((method-list *)) |
258 |
|
`(vector ',p1 ',p2 ',p3 ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) |
259 |
|
(report-and-ignore-errors |
260 |
|
(defgeneric dmc-long-gf-09 (x y) (:method-combination mc-long-09 1 :p3 3))) |
261 |
|
) |
262 |
|
|
263 |
|
(deftest define-method-combination-long.09.1 |
264 |
|
(eqt *dmc-long-09* 'mc-long-09) |
265 |
|
t) |
266 |
|
|
267 |
|
(deftest define-method-combination-long.09.2 |
268 |
|
(progn |
269 |
|
(eval '(defmethod dmc-long-gf-09 ((x (eql 1)) (y integer)) 'a)) |
270 |
|
(eval '(defmethod dmc-long-gf-09 ((x integer) (y (eql 2))) 'b)) |
271 |
|
(eval '(defmethod dmc-long-gf-09 ((x integer) (y integer)) 'z)) |
272 |
|
(values |
273 |
|
(dmc-long-gf-09 0 0) |
274 |
|
(dmc-long-gf-09 1 0) |
275 |
|
(dmc-long-gf-09 0 2) |
276 |
|
(dmc-long-gf-09 1 2))) |
277 |
|
#(1 nil 3 z) #(1 nil 3 a z) #(1 nil 3 b z) #(1 nil 3 a b z)) |
278 |
|
|
279 |
|
(deftest define-method-combination-long.09.3 |
280 |
|
(signals-error (dmc-long-gf-09 nil) error) |
281 |
|
t) |
282 |
|
|
283 |
|
(eval-when (:load-toplevel :compile-toplevel :execute) |
284 |
|
(report-and-ignore-errors |
285 |
|
(defparameter *dmc-long-10* |
286 |
|
(define-method-combination mc-long-10 (p1 &rest p2) ((method-list *)) |
287 |
|
`(vector ',p1 ',p2 ,@(mapcar #'(lambda (m) `(call-method ,m)) method-list))))) |
288 |
|
(report-and-ignore-errors |
289 |
|
(defgeneric dmc-long-gf-10 (x y) (:method-combination mc-long-10 1 2 3 4))) |
290 |
|
) |
291 |
|
|
292 |
|
(deftest define-method-combination-long.10.1 |
293 |
|
(eqt *dmc-long-10* 'mc-long-10) |
294 |
|
t) |
295 |
|
|
296 |
|
(deftest define-method-combination-long.10.2 |
297 |
|
(progn |
298 |
|
(eval '(defmethod dmc-long-gf-10 ((x (eql 1)) (y integer)) 'a)) |
299 |
|
(eval '(defmethod dmc-long-gf-10 ((x integer) (y (eql 2))) 'b)) |
300 |
|
(eval '(defmethod dmc-long-gf-10 ((x integer) (y integer)) 'z)) |
301 |
|
(values |
302 |
|
(dmc-long-gf-10 0 0) |
303 |
|
(dmc-long-gf-10 1 0) |
304 |
|
(dmc-long-gf-10 0 2) |
305 |
|
(dmc-long-gf-10 1 2))) |
306 |
|
#(1 (2 3 4) z) #(1 (2 3 4) a z) #(1 (2 3 4) b z) #(1 (2 3 4) a b z)) |
307 |
|
|
308 |
|
(deftest define-method-combination-long.10.3 |
309 |
|
(signals-error (dmc-long-gf-10 nil) error) |
310 |
|
t) |
311 |
|
|
|
|
|