source: trunk/source/tests/ansi-tests/call-next-method.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.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat May 31 11:18:15 2003
4;;;; Contains: Tests of CALL-NEXT-METHOD
5
6(in-package :cl-test)
7
8;;; Tests where there is no next method are in no-next-method.lsp
9
10(defgeneric cnm-gf-01 (x)
11  (:method ((x integer)) (cons 'a (call-next-method)))
12  (:method ((x rational)) (cons 'b (call-next-method)))
13  (:method ((x real)) (cons 'c (call-next-method)))
14  (:method ((x number)) (cons 'd (call-next-method)))
15  (:method ((x t)) nil))
16
17(deftest call-next-method.1
18  (mapcar #'cnm-gf-01 '(0 2/3 1.3 #c(1 1) a))
19  ((a b c d) (b c d) (c d) (d) nil))
20
21;; Check that call-next-method passes along multiple values correctly
22
23(defgeneric cnm-gf-02 (x)
24  (:method ((x integer)) (call-next-method))
25  (:method ((x number)) (values))
26  (:method ((x (eql 'a))) (call-next-method))
27  (:method ((x symbol)) (values 1 2 3 4 5 6)))
28
29(deftest call-next-method.2
30  (cnm-gf-02 0))
31
32(deftest call-next-method.3
33  (cnm-gf-02 'a)
34  1 2 3 4 5 6)
35
36;;; Call next method has indefinite extent
37
38(defgeneric cnm-gf-03 (x)
39  (:method ((x integer)) #'call-next-method)
40  (:method ((x t)) t))
41
42(deftest call-next-method.4
43  (funcall (cnm-gf-03 0))
44  t)
45
46;;; The arguments to c-n-m can be changed
47
48(defgeneric cnm-gf-04 (x)
49  (:method ((x integer)) (call-next-method (+ x 10)))
50  (:method ((x number)) (1+ x)))
51
52(deftest call-next-method.5
53  (mapcar #'cnm-gf-04 '(0 1 2 5/3 9/2 1.0 #c(1 1)))
54  (11 12 13 8/3 11/2 2.0 #c(2 1)))
55
56;;; call-next-method goes up the list of applicable methods
57;;; which may be to a method with specializers incomparable to
58;;; the current method
59
60(defgeneric cnm-gf-05 (x y)
61  (:method ((x integer) (y integer)) (cons 'a (call-next-method)))
62  (:method ((x integer) (y t))  (cons 'b (call-next-method)))
63  (:method ((x t) (y integer))  (cons 'c (call-next-method)))
64  (:method ((x t) (y t)) (list 'd)))
65
66(deftest call-next-method.6
67  (mapcar #'cnm-gf-05 '(0 0 t t) '(0 t 0 t))
68  ((a b c d)
69   (b d)
70   (c d)
71   (d)))
72
73(defclass cnm-class-01a () ())
74(defclass cnm-class-01b (cnm-class-01a) ())
75(defclass cnm-class-01c (cnm-class-01a) ())
76(defclass cnm-class-01d (cnm-class-01c cnm-class-01b) ())
77
78(defgeneric cnm-gf-06 (x)
79  (:method ((x cnm-class-01d)) (cons 1 (call-next-method)))
80  (:method ((x cnm-class-01c)) (cons 2 (call-next-method)))
81  (:method ((x cnm-class-01b)) (cons 3 (call-next-method)))
82  (:method ((x cnm-class-01a)) (cons 4 (call-next-method)))
83  (:method ((x t)) nil))
84
85(deftest call-next-method.7
86  (values
87   (cnm-gf-06 (make-instance 'cnm-class-01d))
88   (cnm-gf-06 (make-instance 'cnm-class-01c))
89   (cnm-gf-06 (make-instance 'cnm-class-01b))
90   (cnm-gf-06 (make-instance 'cnm-class-01a))
91   (cnm-gf-06 nil))
92  (1 2 3 4)
93  (2 4)
94  (3 4)
95  (4)
96  nil)
97
98;;; Neither rebinding nor setq affects the arguments passed by
99;;; (call-next-method)
100
101(defgeneric cnm-gf-07 (x)
102  (:method ((x integer)) (list (incf x) (call-next-method)))
103  (:method ((x symbol)) (list (setq x 'a) x (call-next-method)))
104  (:method ((x cons)) (list x (let ((x :bad))
105                                (declare (ignorable x))
106                                (call-next-method))))
107  (:method ((x t)) x))
108
109(deftest call-next-method.8
110  (mapcar #'cnm-gf-07 '(0 z (x) #\a))
111  ((1 0) (a a z) ((x) (x)) #\a))
112
113;; Nor does argument defaulting
114
115(defgeneric cnm-gf-08 (x &optional y)
116  (:method ((x integer) &optional y) (list* x y (call-next-method)))
117  (:method ((x t) &optional y) (list x y)))
118
119(deftest call-next-method.9
120  (values
121   (cnm-gf-08 0)
122   (cnm-gf-08 0 t)
123   (cnm-gf-08 'a)
124   (cnm-gf-08 'a 'b))
125  (0 nil 0 nil)
126  (0 t 0 t)
127  (a nil)
128  (a b))
129
130;;; When c-n-m is called with arguments but omits optionals, those
131;;; optionals are defaulted
132
133(defgeneric cnm-gf-09 (x &optional y)
134  (:method ((x integer) &optional y) (list* x y (call-next-method (1+ x))))
135  (:method ((x t) &optional y) (list x y)))
136
137(deftest call-next-method.10
138  (values
139   (cnm-gf-09 5)
140   (cnm-gf-09 8 'a)
141   (cnm-gf-09 'x)
142   (cnm-gf-09 'x 'y))
143  (5 nil 6 nil)
144  (8 a 9 nil)
145  (x nil)
146  (x y))
147
148(defgeneric cnm-gf-10 (x &optional y z)
149  (:method ((x integer) &optional (y 'a y-p) (z 'b z-p))
150           (list* x y (notnot y-p) z (notnot z-p) (call-next-method (1+ x))))
151  (:method ((x t) &optional (y 'c y-p) (z 'd z-p))
152           (list x y (notnot y-p) z (notnot z-p))))
153
154(deftest call-next-method.11
155  (values
156   (cnm-gf-10 5)
157   (cnm-gf-10 8 'p)
158   (cnm-gf-10 8 'p 'q)
159   (cnm-gf-10 'x)
160   (cnm-gf-10 'x 'u)
161   (cnm-gf-10 'x 'u 'v))
162  (5 a nil b nil 6 c nil d nil)
163  (8 p t b nil 9 c nil d nil)
164  (8 p t q t 9 c nil d nil)
165  (x c nil d nil)
166  (x u t d nil)
167  (x u t v t))
168
169;;; "When providing arguments to call-next-method, the following
170;;;  rule must be satisfied or an error of type error should be signaled:
171;;;  the ordered set of applicable methods for a changed set of arguments
172;;;  for call-next-method must be the same as the ordered set of applicable
173;;;  methods for the original arguments to the generic function."
174
175(defgeneric cnm-order-error-gf-01 (x)
176  (declare (optimize (safety 3)))
177  (:method ((x (eql 0)))
178           (declare (optimize (safety 3)))
179           (call-next-method 1))  ;; no longer EQL to 0
180  (:method ((x t)) nil))
181
182(deftest call-next-method.error.1
183  (locally
184   (declare (optimize (safety 3)))
185   (handler-case
186    (eval '(locally (declare (optimize (safety 3)))
187                    (cnm-order-error-gf-01 0)))
188    (error () :error)))
189  :error)
190
191(defgeneric cnm-order-error-gf-02 (x)
192  (declare (optimize (safety 3)))
193  (:method ((x integer))
194           (declare (optimize (safety 3)))
195           (call-next-method :bad))
196  (:method ((x t)) x))
197
198(deftest call-next-method.error.2
199  (locally
200   (declare (optimize (safety 3)))
201   (handler-case
202    (eval '(locally (declare (optimize (safety 3)))
203                    (cnm-order-error-gf-02 0)))
204    (error () :error)))
205  :error)
206
207
208
209           
210
211
212 
213
Note: See TracBrowser for help on using the repository browser.