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

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

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

File size: 7.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Oct 18 07:14:14 2002
4;;;; Contains: Tests for NOTANY
5
6(in-package :cl-test)
7
8(deftest notany.1
9  (not-mv (notany #'identity nil))
10  nil)
11
12(deftest notany.2
13  (not-mv (notany #'identity #()))
14  nil)
15
16(deftest notany.3
17  (let ((count 0))
18    (values
19     (notany #'(lambda (x) (incf count) (if (>= x 10) x nil))
20            '(1 2 4 13 5 1))
21     count))
22  nil 4)
23
24(deftest notany.4
25  (not-mv (notany #'/= '(1 2 3 4) '(1 2 3 4 5)))
26  nil)
27
28(deftest notany.5
29  (not-mv (notany #'/= '(1 2 3 4 5) '(1 2 3 4)))
30  nil)
31
32(deftest notany.6
33  (notany #'/= '(1 2 3 4 5) '(1 2 3 4 6))
34  nil)
35
36(deftest notany.7
37  (not-mv (notany #'(lambda (x y) (and x y))
38               '(nil t t nil t) #(t nil nil t nil nil)))
39  nil)
40
41(deftest notany.8
42  (let* ((x '(1))
43         (args (list x)))
44    (not
45     (loop for i from 2 below (1- (min 100 call-arguments-limit))
46           do (push x args)
47           always (apply #'notany #'/= args))))
48  nil)
49
50(deftest notany.9
51  (not-mv (notany #'zerop #*11111111111111))
52  nil)
53
54(deftest notany.10
55  (not-mv (notany #'zerop #*))
56  nil)
57
58(deftest notany.11
59  (notany #'zerop #*1111111011111)
60  nil)
61
62(deftest notany.12
63  (not-mv (notany #'(lambda (x) (not (eql x #\a))) "aaaaaaaa"))
64  nil)
65
66(deftest notany.13
67  (not-mv (notany #'(lambda (x) (eql x #\a)) ""))
68  nil)
69
70(deftest notany.14
71  (notany #'(lambda (x) (not (eql x #\a))) "aaaaaabaaaa")
72  nil)
73
74(deftest notany.15
75  (not-mv (notany 'null '(1 2 3 4)))
76  nil)
77
78(deftest notany.16
79  (notany 'null '(1 2 3 nil 5))
80  nil)
81
82;;; Other specialized sequences
83
84(deftest notany.17
85  (let ((v (make-array '(10) :initial-contents '(0 0 0 0 1 2 3 4 5 6)
86                       :fill-pointer 4)))
87    (loop for j from 0 to 9
88          do (setf (fill-pointer v) j)
89          collect (not (notany #'plusp v))))
90  (nil nil nil nil nil t t t t t))
91
92(deftest notany.18
93  (loop for i from 1 to 40
94        for type = `(unsigned-byte ,i)
95        unless
96        (let ((v (make-array '(10) :initial-contents (loop for j in '(0 0 0 0 1 2 3 4 5 6)
97                                                           collect (mod j (ash 1 i)))
98                             :element-type type
99                             :fill-pointer 4)))
100          (equal (loop for j from 0 to 9
101                       do (setf (fill-pointer v) j)
102                       collect (not (notany #'plusp v)))
103                 '(nil nil nil nil nil t t t t t)))
104        collect i)
105  nil)
106
107(deftest notany.19
108  (loop for i from 1 to 40
109        for type = `(signed-byte ,i)
110        unless
111        (let ((v (make-array '(10) :initial-contents '(0 0 0 0 -1 -1 -1 -1 -1 -1)
112                             :element-type type
113                             :fill-pointer 4)))
114          (equal (loop for j from 0 to 9
115                       do (setf (fill-pointer v) j)
116                       collect (not (notany #'minusp v)))
117                 '(nil nil nil nil nil t t t t t)))
118        collect i)
119  nil)
120
121(deftest notany.20
122  (let ((v (make-array '(10) :initial-contents "abcd012345"
123                       :element-type 'character
124                       :fill-pointer 4)))
125    (loop for j from 0 to 9
126          do (setf (fill-pointer v) j)
127          collect (not (notany #'digit-char-p v))))
128  (nil nil nil nil nil t t t t t))
129
130(deftest notany.21
131  (let ((v (make-array '(10) :initial-contents "abcd012345"
132                       :element-type 'base-char
133                       :fill-pointer 4)))
134    (loop for j from 0 to 9
135          do (setf (fill-pointer v) j)
136          collect (not (notany #'digit-char-p v))))
137  (nil nil nil nil nil t t t t t))
138
139(deftest notany.22
140  (let ((v (make-array '(5) :initial-contents "abcde"
141                       :element-type 'base-char)))
142    (values
143     (notnot (notany #'digit-char-p v))
144     (setf (aref v 2) #\0)
145     (notany #'digit-char-p v)))
146  t #\0 nil)
147
148(deftest notany.23
149  (loop for type in '(short-float single-float double-float long-float)
150        for v = (make-array '(9)
151                            :element-type type
152                            :initial-contents
153                            (mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6 0 8 3)))
154        when (notany #'zerop v)
155        collect (list type v))
156  nil)
157
158(deftest notany.24
159  (loop for type in '(short-float single-float double-float long-float)
160        for v = (make-array '(9)
161                            :element-type type
162                            :fill-pointer 6
163                            :initial-contents
164                            (mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6 0 8 3)))
165        unless (notany #'zerop v)
166        collect (list type v))
167  nil)
168
169(deftest notany.25
170  (loop for type in '(short-float single-float double-float long-float)
171        for ctype = `(complex ,type)
172        for v = (make-array '(6)
173                            :element-type ctype
174                            :initial-contents
175                            (mapcar #'(lambda (x) (complex x (coerce x type))) '(1 2 3 4 5 6)))
176        unless (notany (complement #'complexp) v)
177        collect (list type v))
178  nil)
179
180;;; Displaced vectors
181
182(deftest notany.26
183  (let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1)))
184         (v2 (make-array '(4) :displaced-to v1
185                         :displaced-index-offset 2)))
186    (values
187     (notany #'oddp v1)
188     (notnot (notany #'oddp v2))))
189  nil t)
190
191(deftest notany.27
192  (loop for i from 1 to 40
193        for type = `(unsigned-byte ,i)
194        unless
195        (let* ((v1 (make-array '(10) :initial-contents '(1 1 0 0 0 0 1 1 1 1)
196                               :element-type type))
197               (v2 (make-array '(4) :displaced-to v1
198                               :displaced-index-offset 2
199                               :element-type type)))
200          (and (not (notany 'oddp v1))
201               (notany #'oddp v2)))
202        collect i)
203  nil)
204
205(deftest notany.28
206  (loop for i from 1 to 40
207        for type = `(signed-byte ,i)
208        unless
209        (let* ((v1 (make-array '(10) :initial-contents '(-1 -1 0 0 0 0 -1 -1 -1 -1)
210                               :element-type type))
211               (v2 (make-array '(4) :displaced-to v1
212                               :displaced-index-offset 2
213                               :element-type type)))
214          (and (not (notany 'oddp v1))
215               (notany #'oddp v2)))
216        collect i)
217  nil)
218
219(deftest notany.29
220  (let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
221    (loop for i from 0 to 6
222          for s2 = (make-array '(2) :element-type 'character
223                               :displaced-to s1
224                               :displaced-index-offset i)
225          collect (not (notany 'digit-char-p s2))))
226  (t t nil nil t t t))
227
228(deftest notany.30
229  (let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'base-char)))
230    (loop for i from 0 to 6
231          for s2 = (make-array '(2) :element-type 'base-char
232                               :displaced-to s1
233                               :displaced-index-offset i)
234          collect (not (notany 'digit-char-p s2))))
235  (t t nil nil t t t))
236
237(deftest notany.31
238  (let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
239                       :adjustable t)))
240    (values
241     (notnot (notany #'minusp v))
242     (progn
243       (adjust-array v '(11) :initial-element -1)
244       (notany #'minusp v))))
245  t nil)
246
247(deftest notany.32
248  (let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
249                       :fill-pointer 10
250                       :adjustable t)))
251    (values
252     (notnot (notany #'minusp v))
253     (progn
254       (adjust-array v '(11) :initial-element -1)
255       (notnot (notany #'minusp v)))))
256  t t)
257
258
259(deftest notany.order.1
260  (let ((i 0) a b)
261    (values
262     (not (notany (progn (setf a (incf i)) 'null)
263                  (progn (setf b (incf i)) '(a b c))))
264     i a b))
265  nil 2 1 2)
266
267;;; Error cases
268
269(deftest notany.error.1
270  (check-type-error #'(lambda (x) (notany x '(a b c)))
271                    (typef '(or symbol function)))
272  nil)
273
274(deftest notany.error.4
275  (check-type-error #'(lambda (x) (notany #'null x)) #'sequencep)
276  nil)
277
278(deftest notany.error.7
279  (check-type-error #'(lambda (x) (notany #'eql () x)) #'sequencep)
280  nil)
281
282(deftest notany.error.8
283  (signals-error (notany) program-error)
284  t)
285
286(deftest notany.error.9
287  (signals-error (notany #'null) program-error)
288  t)
289
290(deftest notany.error.10
291  (signals-error (locally (notany 1 '(a b c)) t) type-error)
292  t)
293
294(deftest notany.error.11
295  (signals-error (notany #'cons '(a b c)) program-error)
296  t)
297
298(deftest notany.error.12
299  (signals-error (notany #'cons '(a b c) '(1 2 4) '(g h j)) program-error)
300  t)
301
302(deftest notany.error.13
303  (signals-error (notany #'car '(a b c)) type-error)
304  t)
Note: See TracBrowser for help on using the repository browser.