Commit a2e999cc authored by pfdietz's avatar pfdietz
Browse files

Tests that c-n-m goes up the CPL, and tests that setq, rebinding and default...

Tests that c-n-m goes up the CPL, and tests that setq, rebinding and default optional args are handled properly.
parent 3e72b319
......@@ -53,6 +53,79 @@
(mapcar #'cnm-gf-04 '(0 1 2 5/3 9/2 1.0 #c(1 1)))
(11 12 13 8/3 11/2 2.0 #c(2 1)))
;;; call-next-method goes up the list of applicable methods
;;; which may be to a method with specializers incomparable to
;;; the current method
(defgeneric cnm-gf-05 (x y)
(:method ((x integer) (y integer)) (cons 'a (call-next-method)))
(:method ((x integer) (y t)) (cons 'b (call-next-method)))
(:method ((x t) (y integer)) (cons 'c (call-next-method)))
(:method ((x t) (y t)) (list 'd)))
(deftest call-next-method.6
(mapcar #'cnm-gf-05 '(0 0 t t) '(0 t 0 t))
((a b c d)
(b d)
(c d)
(d)))
(defclass cnm-class-01a () ())
(defclass cnm-class-01b (cnm-class-01a) ())
(defclass cnm-class-01c (cnm-class-01a) ())
(defclass cnm-class-01d (cnm-class-01c cnm-class-01b) ())
(defgeneric cnm-gf-06 (x)
(:method ((x cnm-class-01d)) (cons 1 (call-next-method)))
(:method ((x cnm-class-01c)) (cons 2 (call-next-method)))
(:method ((x cnm-class-01b)) (cons 3 (call-next-method)))
(:method ((x cnm-class-01a)) (cons 4 (call-next-method)))
(:method ((x t)) nil))
(deftest call-next-method.7
(values
(cnm-gf-06 (make-instance 'cnm-class-01d))
(cnm-gf-06 (make-instance 'cnm-class-01c))
(cnm-gf-06 (make-instance 'cnm-class-01b))
(cnm-gf-06 (make-instance 'cnm-class-01a))
(cnm-gf-06 nil))
(1 2 3 4)
(2 4)
(3 4)
(4)
nil)
;;; Neither rebinding nor setq affects the arguments passed by
;;; (call-next-method)
(defgeneric cnm-gf-07 (x)
(:method ((x integer)) (list (incf x) (call-next-method)))
(:method ((x symbol)) (list (setq x 'a) x (call-next-method)))
(:method ((x cons)) (list x (let ((x :bad))
(declare (ignorable x))
(call-next-method))))
(:method ((x t)) x))
(deftest call-next-method.8
(mapcar #'cnm-gf-07 '(0 z (x) #\a))
((1 0) (a a z) ((x) (x)) #\a))
;; Nor does argument defaulting
(defgeneric cnm-gf-08 (x &optional y)
(:method ((x integer) &optional y) (list* x y (call-next-method)))
(:method ((x t) &optional y) (list x y)))
(deftest call-next-method.9
(values
(cnm-gf-08 0)
(cnm-gf-08 0 t)
(cnm-gf-08 'a)
(cnm-gf-08 'a 'b))
(0 nil 0 nil)
(0 t 0 t)
(a nil)
(a b))
;;; "When providing arguments to call-next-method, the following
;;; rule must be satisfied or an error of type error should be signaled:
......
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