remove-method.lsp 7.22 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun May 11 19:53:37 2003
;;;; Contains: Tests of REMOVE-METHOD

6

7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

(defparameter *remove-meth-gf-01*
  (defgeneric remove-meth-gf-01 (x)))

(defparameter *remove-meth-gf-01-method-t*
  (defmethod remove-meth-gf-01 ((x t)) x))

(defparameter *remove-meth-gf-02*
  (defgeneric remove-meth-gf-02 (x)))

(defparameter *remove-meth-gf-02-method-t*
  (defmethod remove-meth-gf-02 ((x t)) x))

;;; remove method must not signal an error if the method
;;; does not belong to the generic function

(deftest remove-method.1
  (and
   (eqt (remove-method *remove-meth-gf-01* *remove-meth-gf-02-method-t*)
sds's avatar
sds committed
26
        *remove-meth-gf-01*)
27 28 29
   (remove-meth-gf-01 :good))
  :good)

pfdietz's avatar
pfdietz committed
30
;;; Add, then remove, a method
31

pfdietz's avatar
pfdietz committed
32 33 34 35 36
(deftest remove-method.2
  (let (meth)
    (values
     (remove-meth-gf-01 10)
     (progn (setf meth (eval '(defmethod remove-meth-gf-01 ((x integer))
sds's avatar
sds committed
37 38
                                (1+ x))))
            nil)
pfdietz's avatar
pfdietz committed
39 40
     (remove-meth-gf-01 10)
     (eqt *remove-meth-gf-01*
sds's avatar
sds committed
41
          (remove-method *remove-meth-gf-01* meth))
pfdietz's avatar
pfdietz committed
42 43
     (remove-meth-gf-01 10)))
  10 nil 11 t 10)
44

pfdietz's avatar
pfdietz committed
45
;;; Add two disjoint methods, then remove
46

pfdietz's avatar
pfdietz committed
47 48 49 50 51 52
(deftest remove-method.3
  (let (meth1 meth2)
    (values
     (mapcar #'remove-meth-gf-01 '(19 a))
     (progn
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x symbol))
sds's avatar
sds committed
53
                            (list x))))
54

pfdietz's avatar
pfdietz committed
55 56 57
       (mapcar #'remove-meth-gf-01 '(19 a)))
     (progn
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
sds's avatar
sds committed
58
                            (1+ x))))
pfdietz's avatar
pfdietz committed
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74

       (mapcar #'remove-meth-gf-01 '(19 a)))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
     (mapcar #'remove-meth-gf-01 '(19 a))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
     (mapcar #'remove-meth-gf-01 '(19 a))))
  (19 a) (19 (a)) (20 (a)) t (20 a) t (19 a))

;;; Remove in the other order

(deftest remove-method.4
  (let (meth1 meth2)
    (values
     (mapcar #'remove-meth-gf-01 '(19 a))
     (progn
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x symbol))
sds's avatar
sds committed
75
                            (list x))))
pfdietz's avatar
pfdietz committed
76 77 78 79

       (mapcar #'remove-meth-gf-01 '(19 a)))
     (progn
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
sds's avatar
sds committed
80
                            (1+ x))))
pfdietz's avatar
pfdietz committed
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96

       (mapcar #'remove-meth-gf-01 '(19 a)))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
     (mapcar #'remove-meth-gf-01 '(19 a))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
     (mapcar #'remove-meth-gf-01 '(19 a))))
  (19 a) (19 (a)) (20 (a)) t (19 (a)) t (19 a))

;;; Now methods that shadow one another

(deftest remove-method.5
  (let (meth1 meth2)
    (values
     (mapcar #'remove-meth-gf-01 '(10 20.0))
     (progn
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x integer))
sds's avatar
sds committed
97
                            (1- x))))
pfdietz's avatar
pfdietz committed
98 99 100 101

       (mapcar #'remove-meth-gf-01 '(10 20.0)))
     (progn
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
sds's avatar
sds committed
102
                            (1+ x))))
pfdietz's avatar
pfdietz committed
103 104 105 106 107 108 109 110 111 112 113 114 115 116

       (mapcar #'remove-meth-gf-01 '(10 20.0)))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
     (mapcar #'remove-meth-gf-01 '(10 20.0))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
     (mapcar #'remove-meth-gf-01 '(10 20.0))))
  (10 20.0) (9 20.0) (9 21.0) t (11 21.0) t (10 20.0))

(deftest remove-method.6
  (let (meth1 meth2)
    (values
     (mapcar #'remove-meth-gf-01 '(10 20.0))
     (progn
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x integer))
sds's avatar
sds committed
117
                            (1- x))))
pfdietz's avatar
pfdietz committed
118 119 120 121

       (mapcar #'remove-meth-gf-01 '(10 20.0)))
     (progn
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
sds's avatar
sds committed
122
                            (1+ x))))
pfdietz's avatar
pfdietz committed
123 124 125 126 127 128 129 130 131 132 133 134 135 136

       (mapcar #'remove-meth-gf-01 '(10 20.0)))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
     (mapcar #'remove-meth-gf-01 '(10 20.0))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
     (mapcar #'remove-meth-gf-01 '(10 20.0))))
  (10 20.0) (9 20.0) (9 21.0) t (9 20.0) t (10 20.0))

(deftest remove-method.7
  (let (meth1 meth2)
    (values
     (mapcar #'remove-meth-gf-01 '(10 20.0))
     (progn
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x number))
sds's avatar
sds committed
137
                            (1+ x))))
pfdietz's avatar
pfdietz committed
138 139 140 141

       (mapcar #'remove-meth-gf-01 '(10 20.0)))
     (progn
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x integer))
sds's avatar
sds committed
142
                            (1- x))))
pfdietz's avatar
pfdietz committed
143 144 145 146 147 148 149 150

       (mapcar #'remove-meth-gf-01 '(10 20.0)))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
     (mapcar #'remove-meth-gf-01 '(10 20.0))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
     (mapcar #'remove-meth-gf-01 '(10 20.0))))
  (10 20.0) (11 21.0) (9 21.0) t (9 20.0) t (10 20.0))

151
(deftest remove-method.8
pfdietz's avatar
pfdietz committed
152 153 154 155 156
  (let (meth1 meth2)
    (values
     (mapcar #'remove-meth-gf-01 '(10 20.0))
     (progn
       (setf meth1 (eval '(defmethod remove-meth-gf-01 ((x number))
sds's avatar
sds committed
157
                            (1+ x))))
pfdietz's avatar
pfdietz committed
158 159 160 161

       (mapcar #'remove-meth-gf-01 '(10 20.0)))
     (progn
       (setf meth2 (eval '(defmethod remove-meth-gf-01 ((x integer))
sds's avatar
sds committed
162
                            (1- x))))
pfdietz's avatar
pfdietz committed
163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180

       (mapcar #'remove-meth-gf-01 '(10 20.0)))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth2))
     (mapcar #'remove-meth-gf-01 '(10 20.0))
     (eqt *remove-meth-gf-01* (remove-method *remove-meth-gf-01* meth1))
     (mapcar #'remove-meth-gf-01 '(10 20.0))))
  (10 20.0) (11 21.0) (9 21.0) t (11 21.0) t (10 20.0))

;;; Adding and removing auxiliary methods

(declaim (special *rmgf-03-var*))

(defparameter *remove-meth-gf-03*
  (defgeneric remove-meth-gf-03 (x)))

(defparameter *remove-meth-gf-03-method-t*
  (defmethod remove-meth-gf-03 ((x t)) (list *rmgf-03-var* x)))

181
(deftest remove-method.9
pfdietz's avatar
pfdietz committed
182 183 184 185 186
  (let (meth (*rmgf-03-var* 0))
    (values
     (mapcar #'remove-meth-gf-03 '(5 a))
     (progn
       (setf meth (eval '(defmethod remove-meth-gf-03 :before ((x number))
sds's avatar
sds committed
187
                           (incf *rmgf-03-var*))))
pfdietz's avatar
pfdietz committed
188 189 190 191 192 193 194 195
       (mapcar #'remove-meth-gf-03 '(5 a)))
     (eqt *remove-meth-gf-03* (remove-method *remove-meth-gf-03* meth))
     (mapcar #'remove-meth-gf-03 '(5 a))))
  ((0 5) (0 a))
  ((1 5) (1 a))
  t
  ((1 5) (1 a)))

196
(deftest remove-method.10
pfdietz's avatar
pfdietz committed
197 198 199 200 201
  (let (meth (*rmgf-03-var* 0))
    (values
     (mapcar #'remove-meth-gf-03 '(5 a))
     (progn
       (setf meth (eval '(defmethod remove-meth-gf-03 :after ((x number))
sds's avatar
sds committed
202
                           (incf *rmgf-03-var*))))
pfdietz's avatar
pfdietz committed
203 204 205 206 207 208 209
       (mapcar #'remove-meth-gf-03 '(5 a)))
     (eqt *remove-meth-gf-03* (remove-method *remove-meth-gf-03* meth))
     (mapcar #'remove-meth-gf-03 '(5 a))))
  ((0 5) (0 a))
  ((0 5) (1 a))
  t
  ((1 5) (1 a)))
210 211 212 213 214 215 216

(deftest remove-method.11
  (let (meth (*rmgf-03-var* 0))
    (values
     (mapcar #'remove-meth-gf-03 '(5 a))
     (progn
       (setf meth (eval '(defmethod remove-meth-gf-03 :around ((x number))
sds's avatar
sds committed
217 218 219
                           (incf *rmgf-03-var*)
                           (prog1 (call-next-method)
                             (decf *rmgf-03-var*)))))
220 221 222 223 224 225 226
       (mapcar #'remove-meth-gf-03 '(5 a)))
     (eqt *remove-meth-gf-03* (remove-method *remove-meth-gf-03* meth))
     (mapcar #'remove-meth-gf-03 '(5 a))))
  ((0 5) (0 a))
  ((1 5) (0 a))
  t
  ((0 5) (0 a)))
227 228

;;; Must add tests for nonstandard method combinations