source: trunk/source/tests/ansi-tests/defgeneric-method-combination-append.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: 7.1 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 APPEND
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.append.1
13  (let ((*x* nil)
14        (fn
15         (eval '(defgeneric dg-mc.fun.append.1 (x)
16                  (:method-combination append)
17                  (:method append ((x integer)) (car (push '(d) *x*)))
18                  (:method append ((x rational)) (car (push '(c) *x*)))
19                  (:method append ((x number)) (car (push '(b) *x*)))
20                  (:method append ((x t)) (car (push '(a) *x*)))))))
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  ((d c b a) ((a) (b) (c) (d)))
27  ((c b a) ((a) (b) (c)))
28  ((b a) ((a) (b)))
29  ((a) ((a))))
30
31(deftest defgeneric-method-combination.append.2
32  (let ((*x* nil)
33        (fn
34         (eval '(defgeneric dg-mc.fun.append.2 (x)
35                  (:method-combination append :most-specific-first)
36                  (:method append ((x integer)) (car (push '(d) *x*)))
37                  (:method append ((x rational)) (car (push '(c) *x*)))
38                  (:method append ((x number)) (car (push '(b) *x*)))
39                  (:method append ((x t)) (car (push '(a) *x*)))))))
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 c b a) ((a) (b) (c) (d)))
46  ((c b a) ((a) (b) (c)))
47  ((b a) ((a) (b)))
48  ((a) ((a))))
49
50(deftest defgeneric-method-combination.append.3
51  (let ((*x* nil)
52        (fn
53         (eval '(defgeneric dg-mc.fun.append.3 (x)
54                  (:method-combination append :most-specific-last)
55                  (:method append ((x integer)) (car (push '(d) *x*)))
56                  (:method append ((x rational)) (car (push '(c) *x*)))
57                  (:method append ((x number)) (car (push '(b) *x*)))
58                  (:method append ((x t)) (car (push '(a) *x*)))))))
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 b c d) ((d) (c) (b) (a)))
65  ((a b c) ((c) (b) (a)))
66  ((a b) ((b) (a)))
67  ((a) ((a))))
68
69(deftest defgeneric-method-combination.append.4
70  (let ((fn
71         (eval '(defgeneric dg-mc.fun.append.4 (x)
72                  (:method-combination append)
73                  (:method append ((x integer)) '(a b))
74                  (:method :around ((x rational)) 'foo)
75                  (:method append ((x number)) '(c d))
76                  (:method append ((x symbol)) '(e f))
77                  (:method append ((x t)) '(g h))))))
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 (c d g h) (e f g h) (g h))
86
87(deftest defgeneric-method-combination.append.5
88  (let ((fn
89         (eval '(defgeneric dg-mc.fun.append.5 (x)
90                  (:method-combination append)
91                  (:method append ((x integer)) '(a))
92                  (:method :around ((x rational))
93                           (list 'foo (call-next-method)))
94                  (:method append ((x number)) '(b))
95                  (:method append ((x symbol)) '(c))
96                  (:method append ((x t)) 'd)))))
97    (declare (type generic-function fn))
98    (values
99     (funcall fn 0)
100     (funcall fn 4/3)
101     (funcall fn 1.54)
102     (funcall fn 'x)
103     (funcall fn '(a b c))))
104  (foo (a b . d)) (foo (b . d)) (b . d) (c . d) d)
105
106(deftest defgeneric-method-combination.append.6
107  (let ((fn
108         (eval '(defgeneric dg-mc.fun.append.6 (x)
109                  (:method-combination append)
110                  (:method append ((x integer)) '(a))
111                  (:method :around ((x rational))
112                           (list 'foo (call-next-method)))
113                  (:method :around ((x real))
114                           (list 'bar (call-next-method)))
115                  (:method append ((x number)) '(b))
116                  (:method append ((x symbol)) '(c))
117                  (:method append ((x t)) '(d))))))
118    (declare (type generic-function fn))
119    (values
120     (funcall fn 0)
121     (funcall fn 4/3)
122     (funcall fn 1.54)
123     (funcall fn #c(1.0 2.0))
124     (funcall fn 'x)
125     (funcall fn '(a b c))))
126  (foo (bar (a b d))) (foo (bar (b d))) (bar (b d)) (b d) (c d) (d))
127
128(deftest defgeneric-method-combination.append.7
129  (let ((fn
130         (eval '(defgeneric dg-mc.fun.append.7 (x)
131                  (:method-combination append)
132                  (:method append ((x dgmc-class-04)) '(a))
133                  (:method append ((x dgmc-class-03)) '(b))
134                  (:method append ((x dgmc-class-02)) '(c))
135                  (:method append ((x dgmc-class-01)) '(d))))))
136    (declare (type generic-function fn))
137    (values
138     (funcall fn (make-instance 'dgmc-class-01))
139     (funcall fn (make-instance 'dgmc-class-02))
140     (funcall fn (make-instance 'dgmc-class-03))
141     (funcall fn (make-instance 'dgmc-class-04))))
142  (d)
143  (c d)
144  (b d)
145  (a c b d))
146
147(deftest defgeneric-method-combination.append.8
148  (let ((fn
149         (eval '(defgeneric dg-mc.append.8 (x)
150                  (:method-combination append)
151                  (:method append ((x (eql 1000))) '(a))
152                  (:method :around ((x symbol)) (values))
153                  (:method :around ((x integer)) (values 'a 'b 'c))
154                  (:method :around ((x complex)) (call-next-method))
155                  (:method :around ((x number)) (values 1 2 3 4 5 6))
156                  (:method append ((x t)) '(b))))))
157    (declare (type generic-function fn))
158    (values
159     (multiple-value-list (funcall fn 'a))
160     (multiple-value-list (funcall fn 10))
161     (multiple-value-list (funcall fn #c(9 8)))
162     (multiple-value-list (funcall fn '(a b c)))))
163  () (a b c) (1 2 3 4 5 6) ((b)))
164
165(deftest defgeneric-method-combination.append.9
166  (handler-case
167   (let ((fn (eval '(defgeneric dg-mc.append.9 (x)
168                      (:method-combination append)))))
169     (declare (type generic-function fn))
170     (funcall fn '(a)))
171   (error () :error))
172  :error)
173
174(deftest defgeneric-method-combination.append.10
175  (progn
176    (eval '(defgeneric dg-mc.append.10 (x)
177              (:method-combination append)
178              (:method ((x t)) '(a))))
179    (handler-case
180     (dg-mc.append.10 'x)
181     (error () :error)))
182  :error)
183
184(deftest defgeneric-method-combination.append.11
185  (progn
186    (eval '(defgeneric dg-mc.append.11 (x)
187             (:method-combination append)
188             (:method nonsense ((x t)) '(a))))
189    (handler-case
190     (dg-mc.append.11 0)
191     (error () :error)))
192  :error)
193
194(deftest defgeneric-method-combination.append.12
195  (let ((fn (eval '(defgeneric dg-mc.append.12 (x)
196                     (:method-combination append)
197                     (:method :around ((x t)) '(a))
198                     (:method append ((x integer)) x)))))
199    (declare (type generic-function fn))
200    (handler-case (funcall fn '(b))
201                  (error () :error)))
202  :error)
203
204(deftest defgeneric-method-combination.append.13
205  (progn
206    (eval '(defgeneric dg-mc.append.13 (x)
207             (:method-combination append)
208             (:method append ((x dgmc-class-01)) (list 'foo))
209             (:method append ((x dgmc-class-02)) (list 'bar))
210             (:method nonsense ((x dgmc-class-03)) (list 'bad))))
211    (values
212     (dg-mc.append.13 (make-instance 'dgmc-class-01))
213     (dg-mc.append.13 (make-instance 'dgmc-class-02))
214     (handler-case
215      (dg-mc.append.13 (make-instance 'dgmc-class-03))
216      (error () :caught))
217     (handler-case
218      (dg-mc.append.13 (make-instance 'dgmc-class-04))
219      (error () :caught))
220          (handler-case
221      (dg-mc.append.13 (make-instance 'dgmc-class-07))
222      (error () :caught))))
223  (foo)
224  (bar foo)
225  :caught
226  :caught
227  :caught)
Note: See TracBrowser for help on using the repository browser.