source: trunk/source/tests/ansi-tests/defgeneric-method-combination-nconc.lsp @ 8991

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

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

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