source: trunk/source/tests/ansi-tests/defgeneric-method-combination-and.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: 5.8 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 AND
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.and.1
13  (let ((*x* nil)
14        (fn
15         (eval '(defgeneric dg-mc.fun.and.1 (x)
16                  (:method-combination and)
17                  (:method and ((x integer)) (push 4 *x*) t)
18                  (:method and ((x rational)) (push 3 *x*) nil)
19                  (:method and ((x number)) (push 2 *x*) t)
20                  (:method and ((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  (nil (3 4))
27  (nil (3))
28  (a (1 2))
29  (a (1)))
30
31(deftest defgeneric-method-combination.and.2
32  (let ((*x* nil)
33        (fn
34         (eval '(defgeneric dg-mc.fun.and.2 (x)
35                  (:method-combination and :most-specific-first)
36                  (:method and ((x integer)) (push 4 *x*) t)
37                  (:method and ((x rational)) (push 3 *x*) nil)
38                  (:method and ((x number)) (push 2 *x*) t)
39                  (:method and ((x t)) (push 1 *x*) 'a)))))
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  (nil (3 4))
46  (nil (3))
47  (a (1 2))
48  (a (1)))
49
50(deftest defgeneric-method-combination.and.3
51  (let ((*x* nil)
52        (fn
53         (eval '(defgeneric dg-mc.fun.and.3 (x)
54                  (:method-combination and :most-specific-last)
55                  (:method and ((x integer)) (push 4 *x*) t)
56                  (:method and ((x rational)) (push 3 *x*) nil)
57                  (:method and ((x number)) (push 2 *x*) 'a)
58                  (:method and ((x t)) (push 1 *x*) t)))))
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  (nil (3 2 1))
65  (nil (3 2 1))
66  (a (2 1))
67  (t (1)))
68
69(deftest defgeneric-method-combination.and.4
70  (let ((fn
71         (eval '(defgeneric dg-mc.and.4 (x)
72                  (:method-combination and)
73                  (:method and ((x integer)) t)
74                  (:method :around ((x rational)) 'foo)
75                  (:method and ((x number)) nil)
76                  (:method and ((x symbol)) t)
77                  (:method and ((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 nil a a)
86
87(deftest defgeneric-method-combination.and.5
88  (let ((fn
89         (eval '(defgeneric dg-mc.and.5 (x)
90                  (:method-combination and)
91                  (:method and ((x integer)) nil)
92                  (:method :around ((x rational))
93                           (list 'foo (call-next-method)))
94                  (:method and ((x number)) 'a)
95                  (:method and ((x symbol)) 'b)
96                  (:method and ((x t)) 'c)))))
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 nil) (foo c) c c c)
105
106(deftest defgeneric-method-combination.and.6
107  (let ((fn
108         (eval '(defgeneric dg-mc.and.6 (x)
109                  (:method-combination and)
110                  (:method and ((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 and ((x number)) nil)
116                  (:method and ((x symbol)) 'c)
117                  (:method and ((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 nil)) (foo (bar nil)) (bar nil) nil d d)
127
128(deftest defgeneric-method-combination.and.7
129  (let ((fn
130         (eval '(defgeneric dg-mc.and.7 (x)
131                  (:method-combination and)
132                  (:method and ((x dgmc-class-04)) 'c)
133                  (:method and ((x dgmc-class-03)) 'b)
134                  (:method and ((x dgmc-class-02)) nil)
135                  (:method and ((x dgmc-class-01)) 'a)))))
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  a nil a nil)
143 
144(deftest defgeneric-method-combination.and.8
145  (let ((fn
146         (eval '(defgeneric dg-mc.and.8 (x)
147                  (:method-combination and)
148                  (:method and ((x (eql 1000))) 'a)
149                  (:method :around ((x symbol)) (values))
150                  (:method :around ((x integer)) (values 'a 'b 'c))
151                  (:method :around ((x complex)) (call-next-method))
152                  (:method :around ((x number)) (values 1 2 3 4 5 6))
153                  (:method and ((x t)) 'b)))))
154    (declare (type generic-function fn))
155    (values
156     (multiple-value-list (funcall fn 'a))
157     (multiple-value-list (funcall fn 10))
158     (multiple-value-list (funcall fn #c(9 8)))
159     (multiple-value-list (funcall fn '(a b c)))))
160  () (a b c) (1 2 3 4 5 6) (b))
161
162(deftest defgeneric-method-combination.and.9
163  (handler-case
164   (let ((fn (eval '(defgeneric dg-mc.and.9 (x)
165                      (:method-combination and)))))
166     (declare (type generic-function fn))
167     (funcall fn 'x))
168   (error () :error))
169  :error)
170
171(deftest defgeneric-method-combination.and.10
172  (progn
173    (eval '(defgeneric dg-mc.and.10 (x)
174             (:method-combination and)
175             (:method ((x t)) t)))   
176    (handler-case
177     (dg-mc.and.10 'a)
178     (error () :error)))
179  :error)
180
181(deftest defgeneric-method-combination.and.11
182  (progn
183    (eval '(defgeneric dg-mc.and.11 (x)
184             (:method-combination and)
185             (:method nonsense ((x t)) t)))
186    (handler-case
187     (dg-mc.and.11 0)
188     (error () :error)))
189  :error)
190
191(deftest defgeneric-method-combination.and.12
192  (let ((fn (eval '(defgeneric dg-mc.and.12 (x)
193                     (:method-combination and)
194                     (:method :around ((x t)) t)
195                     (:method and ((x integer)) x)))))
196    (declare (type generic-function fn))
197    (handler-case (funcall fn 'x)
198                  (error () :error)))
199  :error)
Note: See TracBrowser for help on using the repository browser.