143 |
(every #'alpha-char-p v))) |
(every #'alpha-char-p v))) |
144 |
t #\0 nil) |
t #\0 nil) |
145 |
|
|
146 |
|
;;; Displaced vectors |
147 |
|
|
148 |
|
(deftest every.23 |
149 |
|
(let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1))) |
150 |
|
(v2 (make-array '(4) :displaced-to v1 |
151 |
|
:displaced-index-offset 2))) |
152 |
|
(values |
153 |
|
(every #'evenp v1) |
154 |
|
(notnot (every 'evenp v2)))) |
155 |
|
nil t) |
156 |
|
|
157 |
|
(deftest every.24 |
158 |
|
(loop for i from 1 to 40 |
159 |
|
for type = `(unsigned-byte ,i) |
160 |
|
unless |
161 |
|
(let* ((v1 (make-array '(10) :initial-contents '(1 1 0 0 0 0 1 1 1 1) |
162 |
|
:element-type type)) |
163 |
|
(v2 (make-array '(4) :displaced-to v1 |
164 |
|
:displaced-index-offset 2 |
165 |
|
:element-type type))) |
166 |
|
(and (not (every 'evenp v1)) |
167 |
|
(every #'evenp v2))) |
168 |
|
collect i) |
169 |
|
nil) |
170 |
|
|
171 |
|
(deftest every.25 |
172 |
|
(loop for i from 1 to 40 |
173 |
|
for type = `(signed-byte ,i) |
174 |
|
unless |
175 |
|
(let* ((v1 (make-array '(10) :initial-contents '(-1 -1 0 0 0 0 -1 -1 -1 -1) |
176 |
|
:element-type type)) |
177 |
|
(v2 (make-array '(4) :displaced-to v1 |
178 |
|
:displaced-index-offset 2 |
179 |
|
:element-type type))) |
180 |
|
(and (not (every 'evenp v1)) |
181 |
|
(every #'evenp v2))) |
182 |
|
collect i) |
183 |
|
nil) |
184 |
|
|
185 |
|
(deftest every.26 |
186 |
|
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character))) |
187 |
|
(loop for i from 0 to 6 |
188 |
|
for s2 = (make-array '(2) :element-type 'character |
189 |
|
:displaced-to s1 |
190 |
|
:displaced-index-offset i) |
191 |
|
collect (notnot (every 'alpha-char-p s2)))) |
192 |
|
(nil nil t t nil nil nil)) |
193 |
|
|
194 |
|
(deftest every.27 |
195 |
|
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'base-char))) |
196 |
|
(loop for i from 0 to 6 |
197 |
|
for s2 = (make-array '(2) :element-type 'base-char |
198 |
|
:displaced-to s1 |
199 |
|
:displaced-index-offset i) |
200 |
|
collect (notnot (every 'alpha-char-p s2)))) |
201 |
|
(nil nil t t nil nil nil)) |
202 |
|
|
203 |
|
;;; adjustable vectors |
204 |
|
|
205 |
|
(deftest every.28 |
206 |
|
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10) |
207 |
|
:adjustable t))) |
208 |
|
(values |
209 |
|
(notnot (every #'plusp v)) |
210 |
|
(progn |
211 |
|
(adjust-array v '(11) :initial-element -1) |
212 |
|
(every #'plusp v)))) |
213 |
|
t nil) |
214 |
|
|
215 |
|
(deftest every.29 |
216 |
|
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10) |
217 |
|
:fill-pointer 10 |
218 |
|
:adjustable t))) |
219 |
|
(values |
220 |
|
(notnot (every #'plusp v)) |
221 |
|
(progn |
222 |
|
(adjust-array v '(11) :initial-element -1) |
223 |
|
(every #'plusp v)))) |
224 |
|
t t) |
225 |
|
|
226 |
|
;;; Float, complex vectors |
227 |
|
|
228 |
|
(deftest every.30 |
229 |
|
(loop for type in '(short-float single-float double-float long-float) |
230 |
|
for v = (make-array '(6) |
231 |
|
:element-type type |
232 |
|
:initial-contents |
233 |
|
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6))) |
234 |
|
unless (every #'plusp v) |
235 |
|
collect (list type v)) |
236 |
|
nil) |
237 |
|
|
238 |
|
(deftest every.31 |
239 |
|
(loop for type in '(short-float single-float double-float long-float) |
240 |
|
for v = (make-array '(6) |
241 |
|
:element-type type |
242 |
|
:fill-pointer 5 |
243 |
|
:initial-contents |
244 |
|
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 -1))) |
245 |
|
unless (every #'plusp v) |
246 |
|
collect (list type v)) |
247 |
|
nil) |
248 |
|
|
249 |
|
(deftest every.32 |
250 |
|
(loop for type in '(short-float single-float double-float long-float) |
251 |
|
for ctype = `(complex ,type) |
252 |
|
for v = (make-array '(6) |
253 |
|
:element-type ctype |
254 |
|
:initial-contents |
255 |
|
(mapcar #'(lambda (x) (complex x (coerce x type))) '(1 2 3 4 5 6))) |
256 |
|
unless (every #'complexp v) |
257 |
|
collect (list type v)) |
258 |
|
nil) |
259 |
|
|
260 |
;;; Order of arguments |
;;; Order of arguments |
261 |
|
|
262 |
(deftest every.order.1 |
(deftest every.order.1 |
330 |
(signals-error (every #'car '(a b c)) type-error) |
(signals-error (every #'car '(a b c)) type-error) |
331 |
t) |
t) |
332 |
|
|
333 |
|
(deftest every.error.14 |
334 |
|
(signals-error (every #'identity '(1 2 3 . 4)) type-error) |
335 |
|
t) |