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