From 69a987f422b0dda474d73fc60d2be90ae2d7ee47 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Wed, 15 Jun 2005 12:52:58 +0000 Subject: [PATCH] Beefed up complement tests. --- ansi-tests/complement.lsp | 80 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/ansi-tests/complement.lsp b/ansi-tests/complement.lsp index f30c8f43..ddcd6f0c 100644 --- a/ansi-tests/complement.lsp +++ b/ansi-tests/complement.lsp @@ -31,6 +31,70 @@ (notnot-mv (complement #'identity)) 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 (let ((i 0)) (let ((fn (complement (progn (incf i) #'null)))) @@ -40,6 +104,8 @@ i))) 1 (t t nil t t nil t nil) 1) +;;; Error tests + (deftest complement.error.1 (signals-error (complement) program-error) t) @@ -57,3 +123,17 @@ (signals-error (funcall (complement #'identity) t t) program-error) 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) -- GitLab