/[gcl]/gcl/ansi-tests/define-method-combination-long-form.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/define-method-combination-long-form.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by pfdietz, Sun Jul 27 02:41:52 2003 UTC revision 1.2 by pfdietz, Wed Jul 6 12:43:27 2005 UTC
# Line 23  Line 23 
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    
       

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26