← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/call-next-method.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/call-next-method.lsp
 
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