source: trunk/source/tests/ansi-tests/defgeneric-method-combination-progn.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: 8.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat May 24 21:31:55 2003
4;;;; Contains: Tests of DEFGENERIC with :method-combination OR
5
6(in-package :cl-test)
7
8(declaim (special *x*))
9
10(compile-and-load "defgeneric-method-combination-aux.lsp")
11
12(deftest defgeneric-method-combination.progn.1
13  (let ((*x* nil)
14        (fn
15         (eval '(defgeneric dg-mc.fun.progn.1 (x)
16                  (:method-combination progn)
17                  (:method progn ((x integer)) (push 4 *x*) nil)
18                  (:method progn ((x rational)) (push 3 *x*) nil)
19                  (:method progn ((x number)) (push 2 *x*) nil)
20                  (:method progn ((x t)) (push 1 *x*) 'a)))))
21    (declare (type generic-function fn))
22    (flet ((%f (y)
23               (let ((*x* nil))
24                 (list (funcall fn y) *x*))))
25    (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
26  (a (1 2 3 4))
27  (a (1 2 3))
28  (a (1 2))
29  (a (1)))
30
31(deftest defgeneric-method-combination.progn.2
32  (let ((*x* nil)
33        (fn
34         (eval '(defgeneric dg-mc.fun.progn.2 (x)
35                  (:method-combination progn :most-specific-first)
36                  (:method progn ((x integer)) (push 4 *x*) 'a)
37                  (:method progn ((x rational)) (push 3 *x*) 'b)
38                  (:method progn ((x number)) (push 2 *x*) 'c)
39                  (:method progn ((x t)) (push 1 *x*) 'd)))))
40    (declare (type generic-function fn))
41    (flet ((%f (y)
42               (let ((*x* nil))
43                 (list (funcall fn y) *x*))))
44    (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
45  (d (1 2 3 4))
46  (d (1 2 3))
47  (d (1 2))
48  (d (1)))
49
50(deftest defgeneric-method-combination.progn.3
51  (let ((*x* nil)
52        (fn
53         (eval '(defgeneric dg-mc.fun.progn.3 (x)
54                  (:method-combination progn :most-specific-last)
55                  (:method progn ((x integer)) (push 4 *x*) 'a)
56                  (:method progn ((x rational)) (push 3 *x*) 'b)
57                  (:method progn ((x number)) (push 2 *x*) 'c)
58                  (:method progn ((x t)) (push 1 *x*) 'd)))))
59    (declare (type generic-function fn))
60    (flet ((%f (y)
61               (let ((*x* nil))
62                 (list (funcall fn y) *x*))))
63    (values (%f 1) (%f 2/3) (%f 1.54) (%f 'a))))
64  (a (4 3 2 1))
65  (b (3 2 1))
66  (c (2 1))
67  (d (1)))
68
69(deftest defgeneric-method-combination.progn.4
70  (let ((fn
71         (eval '(defgeneric dg-mc.progn.4 (x)
72                  (:method-combination progn)
73                  (:method progn ((x integer)) 'd)
74                  (:method :around ((x rational)) 'foo)
75                  (:method progn ((x number)) 'b)
76                  (:method progn ((x symbol)) 'c)
77                  (:method progn ((x t)) 'a)))))
78    (declare (type generic-function fn))
79    (values
80     (funcall fn 0)
81     (funcall fn 4/3)
82     (funcall fn 1.54)
83     (funcall fn 'x)
84     (funcall fn '(a b c))))
85  foo foo a a a)
86
87(deftest defgeneric-method-combination.progn.4a
88  (let ((fn
89         (eval '(defgeneric dg-mc.progn.4a (x)
90                  (:method-combination progn :most-specific-last)
91                  (:method progn ((x integer)) 'd)
92                  (:method :around ((x rational)) 'foo)
93                  (:method progn ((x number)) 'b)
94                  (:method progn ((x symbol)) 'c)
95                  (:method progn ((x t)) 'a)))))
96    (declare (type generic-function fn))
97    (values
98     (funcall fn 0)
99     (funcall fn 4/3)
100     (funcall fn 1.54)
101     (funcall fn 'x)
102     (funcall fn '(a b c))))
103  foo foo b c a)
104
105(deftest defgeneric-method-combination.progn.5
106  (let ((fn
107         (eval '(defgeneric dg-mc.progn.5 (x)
108                  (:method-combination progn)
109                  (:method progn ((x integer)) 'a)
110                  (:method :around ((x rational))
111                           (list 'foo (call-next-method)))
112                  (:method progn ((x number)) nil)
113                  (:method progn ((x symbol)) 'b)
114                  (:method progn ((x t)) 'c)))))
115    (declare (type generic-function fn))
116    (values
117     (funcall fn 0)
118     (funcall fn 4/3)
119     (funcall fn 1.54)
120     (funcall fn 'x)
121     (funcall fn '(a b c))))
122  (foo c) (foo c) c c c)
123
124(deftest defgeneric-method-combination.progn.5a
125  (let ((fn
126         (eval '(defgeneric dg-mc.progn.5a (x)
127                  (:method-combination progn :most-specific-last)
128                  (:method progn ((x integer)) 'a)
129                  (:method :around ((x rational))
130                           (list 'foo (call-next-method)))
131                  (:method progn ((x number)) 'e)
132                  (:method progn ((x symbol)) 'b)
133                  (:method progn ((x t)) 'c)))))
134    (declare (type generic-function fn))
135    (values
136     (funcall fn 0)
137     (funcall fn 4/3)
138     (funcall fn 1.54)
139     (funcall fn 'x)
140     (funcall fn '(a b c))))
141  (foo a) (foo e) e b c)
142
143
144(deftest defgeneric-method-combination.progn.6
145  (let ((fn
146         (eval '(defgeneric dg-mc.progn.6 (x)
147                  (:method-combination progn)
148                  (:method progn ((x integer)) 'a)
149                  (:method :around ((x rational))
150                           (list 'foo (call-next-method)))
151                  (:method :around ((x real))
152                           (list 'bar (call-next-method)))
153                  (:method progn ((x number)) 'b)
154                  (:method progn ((x symbol)) 'c)
155                  (:method progn ((x t)) 'd)))))
156    (declare (type generic-function fn))
157    (values
158     (funcall fn 0)
159     (funcall fn 4/3)
160     (funcall fn 1.54)
161     (funcall fn #c(1.0 2.0))
162     (funcall fn 'x)
163     (funcall fn '(a b c))))
164  (foo (bar d)) (foo (bar d)) (bar d) d d d)
165
166(deftest defgeneric-method-combination.progn.6a
167  (let ((fn
168         (eval '(defgeneric dg-mc.progn.6a (x)
169                  (:method-combination progn :most-specific-last)
170                  (:method progn ((x integer)) 'a)
171                  (:method :around ((x rational))
172                           (list 'foo (call-next-method)))
173                  (:method :around ((x real))
174                           (list 'bar (call-next-method)))
175                  (:method progn ((x number)) 'b)
176                  (:method progn ((x symbol)) 'c)
177                  (:method progn ((x t)) 'd)))))
178    (declare (type generic-function fn))
179    (values
180     (funcall fn 0)
181     (funcall fn 4/3)
182     (funcall fn 1.54)
183     (funcall fn #c(1.0 2.0))
184     (funcall fn 'x)
185     (funcall fn '(a b c))))
186  (foo (bar a)) (foo (bar b)) (bar b) b c d)
187
188
189(deftest defgeneric-method-combination.progn.7
190  (let ((fn
191         (eval '(defgeneric dg-mc.progn.7 (x)
192                  (:method-combination progn)
193                  (:method progn ((x dgmc-class-04)) 'a)
194                  (:method progn ((x dgmc-class-03)) 'b)
195                  (:method progn ((x dgmc-class-02)) 'c)
196                  (:method progn ((x dgmc-class-01)) 'd)))))
197    (declare (type generic-function fn))
198    (values
199     (funcall fn (make-instance 'dgmc-class-01))
200     (funcall fn (make-instance 'dgmc-class-02))
201     (funcall fn (make-instance 'dgmc-class-03))
202     (funcall fn (make-instance 'dgmc-class-04))))
203  d d d d)
204
205(deftest defgeneric-method-combination.progn.7a
206  (let ((fn
207         (eval '(defgeneric dg-mc.progn.7a (x)
208                  (:method-combination progn :most-specific-last)
209                  (:method progn ((x dgmc-class-04)) 'a)
210                  (:method progn ((x dgmc-class-03)) 'b)
211                  (:method progn ((x dgmc-class-02)) 'c)
212                  (:method progn ((x dgmc-class-01)) 'd)))))
213    (declare (type generic-function fn))
214    (values
215     (funcall fn (make-instance 'dgmc-class-01))
216     (funcall fn (make-instance 'dgmc-class-02))
217     (funcall fn (make-instance 'dgmc-class-03))
218     (funcall fn (make-instance 'dgmc-class-04))))
219  d c b a)
220
221(deftest defgeneric-method-combination.progn.8
222  (let ((fn
223         (eval '(defgeneric dg-mc.progn.8 (x)
224                  (:method-combination progn)
225                  (:method progn ((x (eql 1000))) 'a)
226                  (:method :around ((x symbol)) (values))
227                  (:method :around ((x integer)) (values 'a 'b 'c))
228                  (:method :around ((x complex)) (call-next-method))
229                  (:method :around ((x number)) (values 1 2 3 4 5 6))
230                  (:method progn ((x t)) 'b)))))
231    (declare (type generic-function fn))
232    (values
233     (multiple-value-list (funcall fn 'a))
234     (multiple-value-list (funcall fn 10))
235     (multiple-value-list (funcall fn #c(9 8)))
236     (multiple-value-list (funcall fn '(a b c)))))
237  () (a b c) (1 2 3 4 5 6) (b))
238
239(deftest defgeneric-method-combination.progn.9
240  (handler-case
241   (let ((fn (eval '(defgeneric dg-mc.progn.9 (x)
242                      (:method-combination progn)))))
243     (declare (type generic-function fn))
244     (funcall fn (list 'a)))
245   (error () :error))
246  :error)
247
248(deftest defgeneric-method-combination.progn.10
249  (progn
250    (eval '(defgeneric dg-mc.progn.10 (x)
251             (:method-combination progn)
252             (:method ((x t)) 0)))
253    (handler-case
254     (dg-mc.progn.10 'a)
255     (error () :error)))
256  :error)
257
258(deftest defgeneric-method-combination.progn.11
259  (progn
260    (eval '(defgeneric dg-mc.progn.11 (x)
261             (:method-combination progn)
262             (:method nonsense ((x t)) 0)))
263    (handler-case
264     (dg-mc.progn.11 0)
265     (error () :error)))
266  :error)
267
268(deftest defgeneric-method-combination.progn.12
269  (let ((fn (eval '(defgeneric dg-mc.progn.12 (x)
270                     (:method-combination progn)
271                     (:method :around ((x t)) 'a)
272                     (:method progn ((x integer)) x)))))
273    (declare (type generic-function fn))
274    (handler-case (funcall fn 'b)
275                  (error () :error)))
276  :error)
Note: See TracBrowser for help on using the repository browser.