source: trunk/source/tests/ansi-tests/complement.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Oct  6 20:04:33 2002
4;;;; Contains: Tests for COMPLEMENT
5
6(in-package :cl-test)
7
8(deftest complement.1
9  (notnot-mv (funcall (complement #'identity) nil))
10  t)
11
12(deftest complement.2
13  (funcall (complement #'identity) t)
14  nil)
15
16(deftest complement.3
17  (check-predicate
18   #'(lambda (x) (eql (funcall (cl::complement #'not) x)
19                      (not (not x)))))
20  nil)
21
22(deftest complement.4
23  (let ((x '(#\b)))
24    (loop for i from 2 to (min 256 (1- call-arguments-limit))
25          always (progn
26                   (push #\a x)
27                   (apply (complement #'char=) x))))
28  t)
29
30(deftest complement.5
31  (notnot-mv (complement #'identity))
32  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
99  (let ((i 0))
100    (let ((fn (complement (progn (incf i) #'null))))
101      (values
102       i
103       (mapcar fn '(a b nil c 1 nil t nil))
104       i)))
105  1 (t t nil t t nil t nil) 1)
106
107;;; Error tests
108
109(deftest complement.error.1
110  (signals-error (complement) program-error)
111  t)
112
113(deftest complement.error.2
114  (signals-error (complement #'not t) program-error)
115  t)
116
117(deftest complement.error.3
118  (signals-error (funcall (complement #'identity))
119                 program-error)
120  t)
121
122(deftest complement.error.4
123  (signals-error (funcall (complement #'identity) t t)
124                 program-error)
125  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)
Note: See TracBrowser for help on using the repository browser.