/[gcl]/gcl/ansi-tests/remove-method.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/remove-method.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by pfdietz, Mon May 12 01:02:39 2003 UTC revision 1.2 by pfdietz, Mon May 12 02:09:19 2003 UTC
# Line 27  Line 27 
27     (remove-meth-gf-01 :good))     (remove-meth-gf-01 :good))
28    :good)    :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.7
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.8
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.9
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)))

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26