Commit 15b50170 authored by pfdietz's avatar pfdietz
Browse files

Fixed some invalid keyword test bugs.

parent b6596547
......@@ -368,19 +368,21 @@
(funcall fn 1)
(funcall fn 'a)
(funcall fn 1 :foo 2)
(funcall fn 1 :foo 2 :bar 3)
(funcall fn 1 :bar 4)
(funcall fn 'a :foo 'b)
;; (funcall fn 1 :foo 2 :bar 3)
;; (funcall fn 1 :bar 4)
;; (funcall fn 'a :foo 'b)
(funcall fn 'a :bar 'b)
(funcall fn 'a :foo 'c :bar 'b)))
;; (funcall fn 'a :foo 'c :bar 'b)
))
(1 nil)
(a nil)
(1 2)
(1 2)
(1 nil)
(a nil)
;; (1 2)
;; (1 nil)
;; (a nil)
(a b)
(a b))
;; (a b)
)
(deftest defgeneric.14
(let ((fn (eval '(defgeneric defgeneric.fun.14 (x &key &allow-other-keys)
......@@ -424,13 +426,13 @@
(funcall fn 1 :foo 2)
(funcall fn 1 :foo 2 :bar 3)
(funcall fn 1 :bar 4)
(funcall fn 'a :foo 'b)
(funcall fn 'a :allow-other-keys t :foo 'b)
(funcall fn 'a :bar 'b)
(funcall fn 'a :foo 'c :bar 'b)
(funcall fn 'a :foo 'c :bar 'b :allow-other-keys t)
(funcall fn 1 :baz 10)
(funcall fn 'a :baz 10)
;; (funcall fn 'a :baz 10)
(funcall fn 1 :allow-other-keys nil :baz 'a)
(funcall fn 'a :allow-other-keys nil :baz 'b)
;; (funcall fn 'a :allow-other-keys nil :baz 'b)
))
(1 nil)
(a nil)
......@@ -441,9 +443,10 @@
(a b)
(a b)
(1 nil)
(a nil)
;; (a nil)
(1 nil)
(a nil))
;; (a nil)
)
(deftest defgeneric.16
(let ((fn (eval '(defgeneric defgeneric.fun.16 (x &key)
......@@ -532,4 +535,103 @@
(1 5 t 6 nil)
(1 5 t 9 t))
(deftest defgeneric.21
(let ((fn (eval '(defgeneric defgeneric.fun.21 (x &key)
(:method ((x number)
&key (y (1+ x) y-p)
(z (if y-p (1+ y) (+ x 10))
z-p))
(list x y (notnot y-p) z (notnot z-p)))))))
(values
(funcall fn 1)
(funcall fn 1 :y 5)
(funcall fn 1 :y 5 :z 9)
(funcall fn 1 :z 8)
(funcall fn 1 :z 8 :y 4)))
(1 2 nil 11 nil)
(1 5 t 6 nil)
(1 5 t 9 t)
(1 2 nil 8 t)
(1 4 t 8 t))
(deftest defgeneric.22
(let ((fn (eval '(defgeneric defgeneric.fun.22 (x &key)
(:method ((x number) &key ((:allow-other-keys y)))
(list x y))))))
(values
(funcall fn 1)
(funcall fn 1 :allow-other-keys nil)
(funcall fn 1 :allow-other-keys t)
(funcall fn 1 :foo 'x :allow-other-keys t :bar 'y)
(funcall fn 1 :allow-other-keys t :foo 'x)
(funcall fn 1 :allow-other-keys nil :allow-other-keys t)
(funcall fn 1 :foo 'x :allow-other-keys t :allow-other-keys nil)
(funcall fn 1 :allow-other-keys t 'foo 'y :allow-other-keys nil)
(funcall fn 1 :allow-other-keys t :allow-other-keys nil '#:foo 'z)))
(1 nil)
(1 nil)
(1 t)
(1 t)
(1 t)
(1 nil)
(1 t)
(1 t)
(1 t))
(deftest defgeneric.23
(let ((fn (eval '(defgeneric defgeneric.fun.23 (x)
(:method ((x number) &aux (y (1+ x))) (list x y))
(:method ((x symbol) &aux (z (list x))) (list x z))))))
(values
(funcall fn 1)
(funcall fn 'a)))
(1 2) (a (a)))
(deftest defgeneric.24
(let ((fn (eval '(defgeneric defgeneric.fun.24 (x)
(:method ((x number) &aux (y (1+ x)) (z (1+ y)))
(list x y z))
(:method ((x symbol) &aux (y (list x)) (z (list x y)))
(list x y z))))))
(values
(funcall fn 1)
(funcall fn 'a)))
(1 2 3)
(a (a) (a (a))))
(deftest defgeneric.25
(let ((fn (eval '(defgeneric defgeneric.fun.25 (x &optional y &key)
(:method ((x symbol) &optional (y 'd y-p)
&key ((:foo bar) (list x y) bar-p)
&aux (z (list x y (notnot y-p)
bar (notnot bar-p))))
z)))))
(values
(funcall fn 'a)
(funcall fn 'a 'b)
(funcall fn 'a 'b :foo 'c)))
(a d nil (a d) nil)
(a b t (a b) nil)
(a b t c t))
(deftest defgeneric.26
(let ((fn (eval '(defgeneric defgeneric.fun.26 (x)
(declare (optimize (safety 3)))
(:method ((x symbol)) x)
(declare (optimize (debug 3)))))))
(funcall fn 'a))
a)
(defclass substandard-method (standard-method) ())
(deftest defgeneric.27
(let ((fn (eval '(defgeneric defgeneric.fun.27 (x y)
(:method-class substandard-method)
(:method ((x number) (y number)) (+ x y))
(:method ((x string) (y string))
(concatenate 'string x y))))))
(values
(funcall fn 1 2)
(funcall fn "1" "2")))
3 "12")
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