← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/remove-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/remove-method.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sun May 11 19:53:37 2003
 
4
;;;; Contains: Tests of REMOVE-METHOD
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(defparameter *remove-meth-gf-01*
 
9
  (defgeneric remove-meth-gf-01 (x)))
 
10
 
 
11
(defparameter *remove-meth-gf-01-method-t*
 
12
  (defmethod remove-meth-gf-01 ((x t)) x))
 
13
 
 
14
(defparameter *remove-meth-gf-02*
 
15
  (defgeneric remove-meth-gf-02 (x)))
 
16
 
 
17
(defparameter *remove-meth-gf-02-method-t*
 
18
  (defmethod remove-meth-gf-02 ((x t)) x))
 
19
 
 
20
;;; remove method must not signal an error if the method
 
21
;;; does not belong to the generic function
 
22
 
 
23
(deftest remove-method.1
 
24
  (and
 
25
   (eqt (remove-method *remove-meth-gf-01* *remove-meth-gf-02-method-t*)
 
26
        *remove-meth-gf-01*)
 
27
   (remove-meth-gf-01 :good))
 
28
  :good)
 
29
 
 
30
;;; Add, then remove, a method
 
31
 
 
32
(deftest remove-method.2
 
33
  (let (meth)
 
34
    (values
 
35
     (remove-meth-gf-01 10)
 
36
     (progn (setf meth (eval '(defmethod remove-meth-gf-01 ((x integer))
 
37
                                (1+ x))))
 
38
            nil)
 
39
     (remove-meth-gf-01 10)
 
40
     (eqt *remove-meth-gf-01*
 
41
          (remove-method *remove-meth-gf-01* meth))
 
42
     (remove-meth-gf-01 10)))
 
43
  10 nil 11 t 10)
 
44
 
 
45
;;; Add two disjoint methods, then remove
 
46
 
 
47
(deftest remove-method.3
 
48
  (let (meth1 meth2)
 
49
    (values
 
50
     (mapcar #'remove-meth-gf-01 '(19 a))
 
51
     (progn
 
52
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x symbol))
 
53
                            (list x))))
 
54
 
 
55
       (mapcar #'remove-meth-gf-01 '(19 a)))
 
56
     (progn
 
57
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
 
58
                            (1+ x))))
 
59
 
 
60
       (mapcar #'remove-meth-gf-01 '(19 a)))
 
61
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
 
62
     (mapcar #'remove-meth-gf-01 '(19 a))
 
63
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
 
64
     (mapcar #'remove-meth-gf-01 '(19 a))))
 
65
  (19 a) (19 (a)) (20 (a)) t (20 a) t (19 a))
 
66
 
 
67
;;; Remove in the other order
 
68
 
 
69
(deftest remove-method.4
 
70
  (let (meth1 meth2)
 
71
    (values
 
72
     (mapcar #'remove-meth-gf-01 '(19 a))
 
73
     (progn
 
74
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x symbol))
 
75
                            (list x))))
 
76
 
 
77
       (mapcar #'remove-meth-gf-01 '(19 a)))
 
78
     (progn
 
79
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
 
80
                            (1+ x))))
 
81
 
 
82
       (mapcar #'remove-meth-gf-01 '(19 a)))
 
83
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
 
84
     (mapcar #'remove-meth-gf-01 '(19 a))
 
85
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
 
86
     (mapcar #'remove-meth-gf-01 '(19 a))))
 
87
  (19 a) (19 (a)) (20 (a)) t (19 (a)) t (19 a))
 
88
 
 
89
;;; Now methods that shadow one another
 
90
 
 
91
(deftest remove-method.5
 
92
  (let (meth1 meth2)
 
93
    (values
 
94
     (mapcar #'remove-meth-gf-01 '(10 20.0))
 
95
     (progn
 
96
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x integer))
 
97
                            (1- x))))
 
98
 
 
99
       (mapcar #'remove-meth-gf-01 '(10 20.0)))
 
100
     (progn
 
101
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
 
102
                            (1+ x))))
 
103
 
 
104
       (mapcar #'remove-meth-gf-01 '(10 20.0)))
 
105
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
 
106
     (mapcar #'remove-meth-gf-01 '(10 20.0))
 
107
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
 
108
     (mapcar #'remove-meth-gf-01 '(10 20.0))))
 
109
  (10 20.0) (9 20.0) (9 21.0) t (11 21.0) t (10 20.0))
 
110
 
 
111
(deftest remove-method.6
 
112
  (let (meth1 meth2)
 
113
    (values
 
114
     (mapcar #'remove-meth-gf-01 '(10 20.0))
 
115
     (progn
 
116
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x integer))
 
117
                            (1- x))))
 
118
 
 
119
       (mapcar #'remove-meth-gf-01 '(10 20.0)))
 
120
     (progn
 
121
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
 
122
                            (1+ x))))
 
123
 
 
124
       (mapcar #'remove-meth-gf-01 '(10 20.0)))
 
125
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
 
126
     (mapcar #'remove-meth-gf-01 '(10 20.0))
 
127
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
 
128
     (mapcar #'remove-meth-gf-01 '(10 20.0))))
 
129
  (10 20.0) (9 20.0) (9 21.0) t (9 20.0) t (10 20.0))
 
130
 
 
131
(deftest remove-method.7
 
132
  (let (meth1 meth2)
 
133
    (values
 
134
     (mapcar #'remove-meth-gf-01 '(10 20.0))
 
135
     (progn
 
136
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x number))
 
137
                            (1+ x))))
 
138
 
 
139
       (mapcar #'remove-meth-gf-01 '(10 20.0)))
 
140
     (progn
 
141
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x integer))
 
142
                            (1- x))))
 
143
 
 
144
       (mapcar #'remove-meth-gf-01 '(10 20.0)))
 
145
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
 
146
     (mapcar #'remove-meth-gf-01 '(10 20.0))
 
147
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
 
148
     (mapcar #'remove-meth-gf-01 '(10 20.0))))
 
149
  (10 20.0) (11 21.0) (9 21.0) t (9 20.0) t (10 20.0))
 
150
 
 
151
(deftest remove-method.8
 
152
  (let (meth1 meth2)
 
153
    (values
 
154
     (mapcar #'remove-meth-gf-01 '(10 20.0))
 
155
     (progn
 
156
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x number))
 
157
                            (1+ x))))
 
158
 
 
159
       (mapcar #'remove-meth-gf-01 '(10 20.0)))
 
160
     (progn
 
161
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x integer))
 
162
                            (1- x))))
 
163
 
 
164
       (mapcar #'remove-meth-gf-01 '(10 20.0)))
 
165
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
 
166
     (mapcar #'remove-meth-gf-01 '(10 20.0))
 
167
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
 
168
     (mapcar #'remove-meth-gf-01 '(10 20.0))))
 
169
  (10 20.0) (11 21.0) (9 21.0) t (11 21.0) t (10 20.0))
 
170
 
 
171
;;; Adding and removing auxiliary methods
 
172
 
 
173
(declaim (special *rmgf-03-var*))
 
174
 
 
175
(defparameter *remove-meth-gf-03*
 
176
  (defgeneric remove-meth-gf-03 (x)))
 
177
 
 
178
(defparameter *remove-meth-gf-03-method-t*
 
179
  (defmethod remove-meth-gf-03 ((x t)) (list *rmgf-03-var* x)))
 
180
 
 
181
(deftest remove-method.9
 
182
  (let (meth (*rmgf-03-var* 0))
 
183
    (values
 
184
     (mapcar #'remove-meth-gf-03 '(5 a))
 
185
     (progn
 
186
       (setf meth (eval '(defmethod remove-meth-gf-03 :before ((x number))
 
187
                           (incf *rmgf-03-var*))))
 
188
       (mapcar #'remove-meth-gf-03 '(5 a)))
 
189
     (eqt *remove-meth-gf-03* (remove-method *remove-meth-gf-03* meth))
 
190
     (mapcar #'remove-meth-gf-03 '(5 a))))
 
191
  ((0 5) (0 a))
 
192
  ((1 5) (1 a))
 
193
  t
 
194
  ((1 5) (1 a)))
 
195
 
 
196
(deftest remove-method.10
 
197
  (let (meth (*rmgf-03-var* 0))
 
198
    (values
 
199
     (mapcar #'remove-meth-gf-03 '(5 a))
 
200
     (progn
 
201
       (setf meth (eval '(defmethod remove-meth-gf-03 :after ((x number))
 
202
                           (incf *rmgf-03-var*))))
 
203
       (mapcar #'remove-meth-gf-03 '(5 a)))
 
204
     (eqt *remove-meth-gf-03* (remove-method *remove-meth-gf-03* meth))
 
205
     (mapcar #'remove-meth-gf-03 '(5 a))))
 
206
  ((0 5) (0 a))
 
207
  ((0 5) (1 a))
 
208
  t
 
209
  ((1 5) (1 a)))
 
210
 
 
211
(deftest remove-method.11
 
212
  (let (meth (*rmgf-03-var* 0))
 
213
    (values
 
214
     (mapcar #'remove-meth-gf-03 '(5 a))
 
215
     (progn
 
216
       (setf meth (eval '(defmethod remove-meth-gf-03 :around ((x number))
 
217
                           (incf *rmgf-03-var*)
 
218
                           (prog1 (call-next-method)
 
219
                             (decf *rmgf-03-var*)))))
 
220
       (mapcar #'remove-meth-gf-03 '(5 a)))
 
221
     (eqt *remove-meth-gf-03* (remove-method *remove-meth-gf-03* meth))
 
222
     (mapcar #'remove-meth-gf-03 '(5 a))))
 
223
  ((0 5) (0 a))
 
224
  ((1 5) (0 a))
 
225
  t
 
226
  ((0 5) (0 a)))
 
227
 
 
228
;;; Must add tests for nonstandard method combinations