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