source: trunk/source/tests/ansi-tests/define-method-combination-long-form.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 10.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Jul 13 08:26:41 2003
4;;;; Contains: Tests of DEFINE-METHOD-COMBINATION (long form)
5
6(in-package :cl-test)
7
8(eval-when (:load-toplevel :compile-toplevel :execute)
9  (report-and-ignore-errors
10   (defparameter *dmc-long-01*
11     (define-method-combination mc-long-01 nil nil)))
12  (report-and-ignore-errors
13   (defgeneric dmc-long-gf-01 (x y) (:method-combination mc-long-01)))
14  )
15
16(deftest define-method-combination-long.01.1
17  (eqt *dmc-long-01* 'mc-long-01)
18  t)
19
20;;; The list of method groups specifiers for this method combination
21;;; is empty, so no methods are valid.
22(deftest define-method-combination-long.01.2
23  (progn
24    (eval '(defmethod dmc-long-gf-01 ((x t) (y t)) :foo))
25    (handler-case
26     (eval '(dmc-long-gf-01 'a 'b))
27     (error () :caught)))
28  :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
Note: See TracBrowser for help on using the repository browser.