source: trunk/source/tests/ansi-tests/defmethod.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: 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) 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.