Commit aded64e9 authored by pfdietz's avatar pfdietz
Browse files

More remove-method tests.

parent a247e551
......@@ -27,7 +27,183 @@
(remove-meth-gf-01 :good))
:good)
;;; Add, then remove, a method
(deftest remove-method.2
(let (meth)
(values
(remove-meth-gf-01 10)
(progn (setf meth (eval '(defmethod remove-meth-gf-01 ((x integer))
(1+ x))))
nil)
(remove-meth-gf-01 10)
(eqt *remove-meth-gf-01*
(remove-method *remove-meth-gf-01* meth))
(remove-meth-gf-01 10)))
10 nil 11 t 10)
;;; Add two disjoint methods, then remove
(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))
(list x))))
(mapcar #'remove-meth-gf-01 '(19 a)))
(progn
(setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
(1+ x))))
(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))
(list x))))
(mapcar #'remove-meth-gf-01 '(19 a)))
(progn
(setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
(1+ x))))
(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))
(1- x))))
(mapcar #'remove-meth-gf-01 '(10 20.0)))
(progn
(setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
(1+ x))))
(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))
(1- x))))
(mapcar #'remove-meth-gf-01 '(10 20.0)))
(progn
(setf meth2 (eval '(defmethod remove-meth-gf-01 ((x number))
(1+ x))))
(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))
(1+ x))))
(mapcar #'remove-meth-gf-01 '(10 20.0)))
(progn
(setf meth2 (eval '(defmethod remove-meth-gf-01 ((x integer))
(1- x))))
(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))
(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))
(1+ x))))
(mapcar #'remove-meth-gf-01 '(10 20.0)))
(progn
(setf meth2 (eval '(defmethod remove-meth-gf-01 ((x integer))
(1- x))))
(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)))
(deftest remove-method.8
(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))
(incf *rmgf-03-var*))))
(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)))
(deftest remove-method.9
(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))
(incf *rmgf-03-var*))))
(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)))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment