Skip to content
Snippets Groups Projects
Commit 69a987f4 authored by pfdietz's avatar pfdietz
Browse files

Beefed up complement tests.

parent ce01293a
No related branches found
No related tags found
No related merge requests found
...@@ -31,6 +31,70 @@ ...@@ -31,6 +31,70 @@
(notnot-mv (complement #'identity)) (notnot-mv (complement #'identity))
t) t)
(deftest complement.6
(flet ((%f (&rest args) (notnot (evenp (length args)))))
(let ((cf (complement #'%f)))
(values
(%f) (%f 'a) (%f 'a 'b) (%f 'a 'b 'c)
(funcall cf) (funcall cf 'a) (funcall cf 'a 'b) (funcall cf 'a 'b 'c))))
t nil t nil
nil t nil t)
(deftest complement.7
(flet ((%f (&optional x y) (if x (not y) y)))
(let ((cf (complement #'%f)))
(values
(%f) (%f nil) (%f t) (%f nil nil) (%f t nil) (%f nil t) (%f t t)
(funcall cf) (funcall cf nil) (funcall cf t)
(funcall cf nil nil) (funcall cf t nil)
(funcall cf nil t) (funcall cf t t))))
nil nil t nil t t nil
t t nil t nil nil t)
(deftest complement.8
(flet ((%f (&key x y) (if x (not y) y)))
(let ((cf (complement #'%f)))
(values
(list
(%f)
(%f :x nil) (%f :x t)
(%f :y nil) (%f :y t :y nil)
(%f :x nil :y nil) (%f :x t :y nil)
(%f :y t :x nil) (%f :x t :y t))
(list
(funcall cf) (funcall cf :x nil) (funcall cf :x t)
(funcall cf :y nil) (funcall cf :y t)
(funcall cf :x nil :y nil) (funcall cf :x t :y nil)
(funcall cf :y t :x nil) (funcall cf :x t :y t :x nil))
(list
(funcall cf :x nil :y t :foo nil :allow-other-keys t)
(funcall cf :x nil :y t :allow-other-keys nil)))))
(nil nil t nil t nil t t nil)
(t t nil t nil t nil nil t)
(nil nil))
(deftest complement.9
(let ((sym (gensym)))
(eval `(defgeneric ,sym (x y)))
(eval `(defmethod ,sym ((x integer) (y integer)) (evenp (+ x y))))
(eval `(defmethod ,sym ((x t) (y t)) nil))
(let ((cf (complement (symbol-function sym))))
(values (funcall cf 'a 'b)
(funcall cf 0 0)
(funcall cf 0 1)
(funcall cf 1 0)
(funcall cf 1 1))))
t nil t t nil)
(deftest complement.10
(let ((cf (complement (compile nil '(lambda (x y) (evenp (+ x y)))))))
(values (funcall cf 0 0)
(funcall cf 0 1)
(funcall cf 1 0)
(funcall cf 1 1)))
nil t t nil)
(deftest complement.order.1 (deftest complement.order.1
(let ((i 0)) (let ((i 0))
(let ((fn (complement (progn (incf i) #'null)))) (let ((fn (complement (progn (incf i) #'null))))
...@@ -40,6 +104,8 @@ ...@@ -40,6 +104,8 @@
i))) i)))
1 (t t nil t t nil t nil) 1) 1 (t t nil t t nil t nil) 1)
;;; Error tests
(deftest complement.error.1 (deftest complement.error.1
(signals-error (complement) program-error) (signals-error (complement) program-error)
t) t)
...@@ -57,3 +123,17 @@ ...@@ -57,3 +123,17 @@
(signals-error (funcall (complement #'identity) t t) (signals-error (funcall (complement #'identity) t t)
program-error) program-error)
t) t)
(deftest complement.error.5
(signals-error (funcall (complement #'(lambda (&key) t)) :foo t) program-error)
t)
(deftest complement.error.6
(signals-error (funcall (complement #'(lambda (&key) t)) :allow-other-keys nil
:allow-other-keys t :foo t) program-error)
t)
(deftest complement.error.7
(signals-error (funcall (complement #'(lambda (x &rest y) (and x (evenp (length y))))))
program-error)
t)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment