/[gcl]/gcl/ansi-tests/every.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/every.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.12 by pfdietz, Fri Aug 27 13:26:33 2004 UTC revision 1.13 by pfdietz, Sat Aug 28 20:52:38 2004 UTC
# Line 143  Line 143 
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
# Line 216  Line 330 
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)

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26