source: trunk/tests/ansi-tests/defmethod.lsp @ 14368

Last change on this file since 14368 was 14368, checked in by gz, 9 years ago

Don't muffle warnings when running test, as that affects the return values from compile-file. Tweak tests to not cause warnings

File size: 6.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Jun  9 07:02:53 2005
4;;;; Contains: Separate tests for DEFMETHOD
5
6(in-package :cl-test)
7
8(deftest defmethod.1
9  (let ((sym (gensym)))
10    (values
11     (typep* (eval `(defmethod ,sym (x) (list x))) 'standard-method)
12     (typep* (fdefinition sym) 'standard-generic-function)
13     (funcall sym 1)))
14  t t (1))
15
16(deftest defmethod.2
17  (let* ((sym (gensym))
18         (method
19          (eval `(defmethod ,sym ((x integer)) (list x)))))
20    (values
21     (typep* method 'standard-method)
22     (typep* (fdefinition sym) 'standard-generic-function)
23     (funcall sym 1)))
24  t t (1))
25
26(deftest defmethod.3
27  (let* ((sym (gensym))
28         (method
29          (eval `(let ((x 0)) (defmethod ,sym ((x (eql (incf x)))) (list x))))))
30    (values
31     (typep* method 'standard-method)
32     (typep* (fdefinition sym) 'standard-generic-function)
33     (funcall sym 1)
34     (funcall sym 1)))
35  t t (1) (1))
36
37(deftest defmethod.4
38  (let* ((sym (gensym))
39         (method
40          (eval `(defmethod (setf ,sym) ((x t) (y cons)) (setf (car y) x)))))
41    (values
42     (typep* method 'standard-method)
43     (fboundp sym)
44     (typep* (fdefinition `(setf ,sym)) 'standard-generic-function)
45     (let ((x (cons 1 2))) (list (funcall (fdefinition `(setf ,sym)) 3 x) x))))
46  t nil t (3 (3 . 2)))
47
48(deftest defmethod.5
49  (let* ((sym (gensym))
50         (method
51          (eval `(defmethod ,sym ((x integer)) (return-from ,sym (list x))))))
52    (values
53     (typep* method 'standard-method)
54     (typep* (fdefinition sym) 'standard-generic-function)
55     (funcall sym 1)))
56  t t (1))
57
58(deftest defmethod.6
59  (let* ((sym (gensym))
60         (method
61          (eval `(defmethod (setf ,sym) ((x t) (y cons)) (return-from ,sym (setf (car y) x))))))
62    (values
63     (typep* method 'standard-method)
64     (fboundp sym)
65     (typep* (fdefinition `(setf ,sym)) 'standard-generic-function)
66     (let ((x (cons 1 2))) (list (funcall (fdefinition `(setf ,sym)) 3 x) x))))
67  t nil t (3 (3 . 2)))
68
69(deftest defmethod.7
70  (let* ((sym (gensym))
71         (method
72          (eval `(defmethod ,sym ((x integer) &aux (y (list x))) y))))
73    (values
74     (typep* method 'standard-method)
75     (typep* (fdefinition sym) 'standard-generic-function)
76     (funcall sym 1)))
77  t t (1))
78
79(deftest defmethod.8
80  (let* ((sym (gensym))
81         (method (eval `(defmethod ,sym ((x integer) &key z) (list x z)))))
82    (values
83     (typep* method 'standard-method)
84     (typep* (fdefinition sym) 'standard-generic-function)
85     (funcall sym 1)
86     (funcall sym 2 :z 3)
87     (funcall sym 4 :allow-other-keys nil)
88     (funcall sym 5 :allow-other-keys t :bogus 17)
89     (funcall sym 6 :allow-other-keys t :allow-other-keys nil :bogus 17)
90     ))
91  t t (1 nil) (2 3) (4 nil) (5 nil) (6 nil))
92
93(deftest defmethod.9
94  (let* ((sym (gensym))
95         (method (eval `(defmethod ,sym ((x integer) &key (z :missing)) (list x z)))))
96    (values
97     (typep* method 'standard-method)
98     (typep* (fdefinition sym) 'standard-generic-function)
99     (funcall sym 1)
100     (funcall sym 2 :z 3)
101     (funcall sym 4 :allow-other-keys nil)
102     ))
103  t t (1 :missing) (2 3) (4 :missing))
104
105(deftest defmethod.10
106  (let* ((sym (gensym))
107         (method (eval `(defmethod ,sym ((x integer) &key (z :missing z-p)) (list x z (notnot z-p))))))
108    (values
109     (typep* method 'standard-method)
110     (typep* (fdefinition sym) 'standard-generic-function)
111     (funcall sym 1)
112     (funcall sym 2 :z 3)
113     (funcall sym 4 :allow-other-keys nil)
114     ))
115  t t (1 :missing nil) (2 3 t) (4 :missing nil))
116
117(deftest defmethod.11
118  (let* ((sym (gensym))
119         (method (eval `(defmethod ,sym ((x integer) &rest z) (list x z)))))
120    (values
121     (typep* method 'standard-method)
122     (typep* (fdefinition sym) 'standard-generic-function)
123     (funcall sym 1)
124     (funcall sym 2 3)
125     ))
126  t t (1 nil) (2 (3)))
127
128;;; Error cases
129
130;;; Lambda liss not congruent
131
132(deftest defmethod.error.1
133  (let ((sym (gensym)))
134    (eval `(defgeneric ,sym (x y)))
135    (eval `(signals-error (defmethod ,sym ((x t)) x) error)))
136  t)
137
138(deftest defmethod.error.2
139  (let ((sym (gensym)))
140    (eval `(defgeneric ,sym (x y)))
141    (eval `(signals-error (defmethod ,sym ((x t) (y t) (z t)) (list x y z)) error)))
142  t)
143
144(deftest defmethod.error.3
145  (let ((sym (gensym)))
146    (eval `(defgeneric ,sym (x y &optional z)))
147    (eval `(signals-error (defmethod ,sym ((x t) (y t) (z t)) (list x y z)) error)))
148  t)
149
150(deftest defmethod.error.4
151  (let ((sym (gensym)))
152    (eval `(defgeneric ,sym (x y &optional z)))
153    (eval `(signals-error (defmethod ,sym ((x t) (y t) &optional) (list x y)) error)))
154  t)
155
156(deftest defmethod.error.5
157  (let ((sym (gensym)))
158    (eval `(defgeneric ,sym (x y &optional z)))
159    (eval `(signals-error (defmethod ,sym ((x t) (y t) &optional z w) (list x y z w)) error)))
160  t)
161
162(deftest defmethod.error.6
163  (let ((sym (gensym)))
164    (eval `(defgeneric ,sym (x &rest z)))
165    (eval `(signals-error (defmethod ,sym ((x t)) (list x)) error)))
166  t)
167
168(deftest defmethod.error.7
169  (let ((sym (gensym)))
170    (eval `(defgeneric ,sym (x)))
171    (eval `(signals-error (defmethod ,sym ((x t) &rest z) (list x z)) error)))
172  t)
173
174(deftest defmethod.error.8
175  (let ((sym (gensym)))
176    (eval `(defgeneric ,sym (x &key z)))
177    (eval `(signals-error (defmethod ,sym ((x t)) (list x)) error)))
178  t)
179
180(deftest defmethod.error.9
181  (let ((sym (gensym)))
182    (eval `(defgeneric ,sym (x)))
183    (eval `(signals-error (defmethod ,sym ((x t) &key z) (list x z)) error)))
184  t)
185
186(deftest defmethod.error.10
187  (let ((sym (gensym)))
188    (eval `(defgeneric ,sym (x &key z)))
189    (eval `(signals-error (defmethod ,sym ((x t) &key) x) error)))
190  t)
191
192(deftest defmethod.error.11
193  (let ((sym (gensym)))
194    (eval `(defgeneric ,sym (x &key)))
195    (eval `(signals-error (defmethod ,sym ((x t)) x) error)))
196  t)
197
198(deftest defmethod.error.12
199  (let ((sym (gensym)))
200    (eval `(defgeneric ,sym (x)))
201    (eval `(signals-error (defmethod ,sym ((x t) &key) x) error)))
202  t)
203
204;;; Calling the implicitly defined generic function
205
206(deftest defmethod.error.13
207  (let ((sym (gensym)))
208    (eval `(locally (declare (optimize safety)) (defmethod ,sym ((x t)) x)))
209    (values (eval `(signals-error (,sym) program-error))
210            (eval `(signals-error (,sym 1 2) program-error))))
211  t t)
212
213(deftest defmethod.error.14
214  (let ((sym (gensym)))
215    (eval `(locally (declare (optimize safety)) (defmethod ,sym ((x t) &key) x)))
216    (values (eval `(signals-error (,sym) program-error))
217            (eval `(signals-error (,sym 1 2) program-error))
218            (eval `(signals-error (,sym 1 :bogus t) program-error))
219            (eval `(signals-error (,sym 1 :allow-other-keys nil :allow-other-keys t :bogus t) program-error))))
220  t t t t)
221
222(deftest defmethod.error.15
223  (let ((sym (gensym)))
224    (eval `(locally (declare (optimize safety)) (defmethod ,sym ((x t) &key y) y x)))
225    (values (eval `(signals-error (,sym 1 :bogus t) program-error))
226            (eval `(signals-error (,sym 1 :y) program-error))
227            (eval `(signals-error (,sym 1 3 nil) program-error))))
228  t t t)
229
230
Note: See TracBrowser for help on using the repository browser.