31 |
(notnot-mv (complement #'identity)) |
(notnot-mv (complement #'identity)) |
32 |
t) |
t) |
33 |
|
|
34 |
|
(deftest complement.6 |
35 |
|
(flet ((%f (&rest args) (notnot (evenp (length args))))) |
36 |
|
(let ((cf (complement #'%f))) |
37 |
|
(values |
38 |
|
(%f) (%f 'a) (%f 'a 'b) (%f 'a 'b 'c) |
39 |
|
(funcall cf) (funcall cf 'a) (funcall cf 'a 'b) (funcall cf 'a 'b 'c)))) |
40 |
|
t nil t nil |
41 |
|
nil t nil t) |
42 |
|
|
43 |
|
(deftest complement.7 |
44 |
|
(flet ((%f (&optional x y) (if x (not y) y))) |
45 |
|
(let ((cf (complement #'%f))) |
46 |
|
(values |
47 |
|
(%f) (%f nil) (%f t) (%f nil nil) (%f t nil) (%f nil t) (%f t t) |
48 |
|
(funcall cf) (funcall cf nil) (funcall cf t) |
49 |
|
(funcall cf nil nil) (funcall cf t nil) |
50 |
|
(funcall cf nil t) (funcall cf t t)))) |
51 |
|
nil nil t nil t t nil |
52 |
|
t t nil t nil nil t) |
53 |
|
|
54 |
|
(deftest complement.8 |
55 |
|
(flet ((%f (&key x y) (if x (not y) y))) |
56 |
|
(let ((cf (complement #'%f))) |
57 |
|
(values |
58 |
|
(list |
59 |
|
(%f) |
60 |
|
(%f :x nil) (%f :x t) |
61 |
|
(%f :y nil) (%f :y t :y nil) |
62 |
|
(%f :x nil :y nil) (%f :x t :y nil) |
63 |
|
(%f :y t :x nil) (%f :x t :y t)) |
64 |
|
|
65 |
|
(list |
66 |
|
(funcall cf) (funcall cf :x nil) (funcall cf :x t) |
67 |
|
(funcall cf :y nil) (funcall cf :y t) |
68 |
|
(funcall cf :x nil :y nil) (funcall cf :x t :y nil) |
69 |
|
(funcall cf :y t :x nil) (funcall cf :x t :y t :x nil)) |
70 |
|
(list |
71 |
|
(funcall cf :x nil :y t :foo nil :allow-other-keys t) |
72 |
|
(funcall cf :x nil :y t :allow-other-keys nil))))) |
73 |
|
(nil nil t nil t nil t t nil) |
74 |
|
(t t nil t nil t nil nil t) |
75 |
|
(nil nil)) |
76 |
|
|
77 |
|
(deftest complement.9 |
78 |
|
(let ((sym (gensym))) |
79 |
|
(eval `(defgeneric ,sym (x y))) |
80 |
|
(eval `(defmethod ,sym ((x integer) (y integer)) (evenp (+ x y)))) |
81 |
|
(eval `(defmethod ,sym ((x t) (y t)) nil)) |
82 |
|
(let ((cf (complement (symbol-function sym)))) |
83 |
|
(values (funcall cf 'a 'b) |
84 |
|
(funcall cf 0 0) |
85 |
|
(funcall cf 0 1) |
86 |
|
(funcall cf 1 0) |
87 |
|
(funcall cf 1 1)))) |
88 |
|
t nil t t nil) |
89 |
|
|
90 |
|
(deftest complement.10 |
91 |
|
(let ((cf (complement (compile nil '(lambda (x y) (evenp (+ x y))))))) |
92 |
|
(values (funcall cf 0 0) |
93 |
|
(funcall cf 0 1) |
94 |
|
(funcall cf 1 0) |
95 |
|
(funcall cf 1 1))) |
96 |
|
nil t t nil) |
97 |
|
|
98 |
(deftest complement.order.1 |
(deftest complement.order.1 |
99 |
(let ((i 0)) |
(let ((i 0)) |
100 |
(let ((fn (complement (progn (incf i) #'null)))) |
(let ((fn (complement (progn (incf i) #'null)))) |
104 |
i))) |
i))) |
105 |
1 (t t nil t t nil t nil) 1) |
1 (t t nil t t nil t nil) 1) |
106 |
|
|
107 |
|
;;; Error tests |
108 |
|
|
109 |
(deftest complement.error.1 |
(deftest complement.error.1 |
110 |
(signals-error (complement) program-error) |
(signals-error (complement) program-error) |
111 |
t) |
t) |
123 |
(signals-error (funcall (complement #'identity) t t) |
(signals-error (funcall (complement #'identity) t t) |
124 |
program-error) |
program-error) |
125 |
t) |
t) |
126 |
|
|
127 |
|
(deftest complement.error.5 |
128 |
|
(signals-error (funcall (complement #'(lambda (&key) t)) :foo t) program-error) |
129 |
|
t) |
130 |
|
|
131 |
|
(deftest complement.error.6 |
132 |
|
(signals-error (funcall (complement #'(lambda (&key) t)) :allow-other-keys nil |
133 |
|
:allow-other-keys t :foo t) program-error) |
134 |
|
t) |
135 |
|
|
136 |
|
(deftest complement.error.7 |
137 |
|
(signals-error (funcall (complement #'(lambda (x &rest y) (and x (evenp (length y)))))) |
138 |
|
program-error) |
139 |
|
t) |