every.lsp 8.88 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Oct 17 23:25:58 2002
;;;; Contains: Tests of EVERY

6

7 8

(deftest every.1
9 10
  (notnot-mv (every #'identity nil))
  t)
11 12

(deftest every.2
13 14
  (notnot-mv (every #'identity #()))
  t)
15 16 17 18 19

(deftest every.3
  (let ((count 0))
    (values
     (every #'(lambda (x) (incf count) (< x 10))
sds's avatar
sds committed
20
            '(1 2 4 13 5 1))
21 22 23 24
     count))
  nil 4)

(deftest every.4
25 26
  (notnot-mv (every #'= '(1 2 3 4) '(1 2 3 4 5)))
  t)
27 28

(deftest every.5
29 30
  (notnot-mv (every #'= '(1 2 3 4 5) '(1 2 3 4)))
  t)
31 32 33 34 35 36

(deftest every.6
  (every #'= '(1 2 3 4 5) '(1 2 3 4 6))
  nil)

(deftest every.7
37
  (notnot-mv (every #'(lambda (x y) (or x y))
sds's avatar
sds committed
38
                    '(nil t t nil t) #(t nil t t nil nil)))
39
  t)
40 41 42

(deftest every.8
  (let ((x '(1))
sds's avatar
sds committed
43
        (args nil))
44
    (loop for i from 1 below (1- (min 100 call-arguments-limit))
sds's avatar
sds committed
45 46
          do (push x args)
          always (apply #'every #'= args)))
47
  t)
48 49

(deftest every.9
50 51
  (notnot-mv (every #'zerop #*000000000000))
  t)
52 53

(deftest every.10
54 55
  (notnot-mv (every #'zerop #*))
  t)
56 57 58 59 60 61

(deftest every.11
  (every #'zerop #*0000010000)
  nil)

(deftest every.12
62 63
  (notnot-mv (every #'(lambda (x) (eql x #\a)) "aaaaaaaa"))
  t)
64 65

(deftest every.13
66 67
  (notnot-mv (every #'(lambda (x) (eql x #\a)) ""))
  t)
68 69 70 71 72

(deftest every.14
  (every #'(lambda (x) (eql x #\a)) "aaaaaabaaaa")
  nil)

73
(deftest every.15
74 75 76 77
  (every 'null '(nil nil t nil))
  nil)

(deftest every.16
78 79
  (notnot-mv (every 'null '(nil nil nil nil)))
  t)
80

81 82 83 84
;;; Other specialized sequences

(deftest every.17
  (let ((v (make-array '(10) :initial-contents '(0 0 0 0 1 2 3 4 5 6)
sds's avatar
sds committed
85
                       :fill-pointer 4)))
86
    (loop for j from 0 to 9
sds's avatar
sds committed
87 88
          do (setf (fill-pointer v) j)
          collect (notnot (every #'zerop v))))
89 90 91 92
  (t t t t t nil nil nil nil nil))

(deftest every.18
  (loop for i from 1 to 40
sds's avatar
sds committed
93 94 95 96 97 98 99 100 101 102
        for type = `(unsigned-byte ,i)
        unless
        (let ((v (make-array '(10) :initial-contents '(0 0 0 0 1 1 1 1 1 1)
                             :element-type type
                             :fill-pointer 4)))
          (equal (loop for j from 0 to 9
                       do (setf (fill-pointer v) j)
                       collect (notnot (every #'zerop v)))
                 '(t t t t t nil nil nil nil nil)))
        collect i)
103 104 105 106
  nil)

(deftest every.19
  (loop for i from 1 to 40
sds's avatar
sds committed
107 108 109 110 111 112 113 114 115 116
        for type = `(signed-byte ,i)
        unless
        (let ((v (make-array '(10) :initial-contents '(0 0 0 0 -1 -1 -1 -1 -1 -1)
                             :element-type type
                             :fill-pointer 4)))
          (equal (loop for j from 0 to 9
                       do (setf (fill-pointer v) j)
                       collect (notnot (every #'zerop v)))
                 '(t t t t t nil nil nil nil nil)))
        collect i)
117 118 119 120
  nil)

(deftest every.20
  (let ((v (make-array '(10) :initial-contents "abcd012345"
sds's avatar
sds committed
121 122
                       :element-type 'character
                       :fill-pointer 4)))
123
    (loop for j from 0 to 9
sds's avatar
sds committed
124 125
          do (setf (fill-pointer v) j)
          collect (notnot (every #'alpha-char-p v))))
126 127 128 129
  (t t t t t nil nil nil nil nil))

(deftest every.21
  (let ((v (make-array '(10) :initial-contents "abcd012345"
sds's avatar
sds committed
130 131
                       :element-type 'base-char
                       :fill-pointer 4)))
132
    (loop for j from 0 to 9
sds's avatar
sds committed
133 134
          do (setf (fill-pointer v) j)
          collect (notnot (every #'alpha-char-p v))))
135 136 137 138
  (t t t t t nil nil nil nil nil))

(deftest every.22
  (let ((v (make-array '(5) :initial-contents "abcde"
sds's avatar
sds committed
139
                       :element-type 'base-char)))
140 141 142 143 144 145
    (values
     (notnot (every #'alpha-char-p v))
     (setf (aref v 2) #\0)
     (every #'alpha-char-p v)))
  t #\0 nil)

146 147 148 149
;;; Displaced vectors

(deftest every.23
  (let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1)))
sds's avatar
sds committed
150 151
         (v2 (make-array '(4) :displaced-to v1
                         :displaced-index-offset 2)))
152 153 154 155 156 157 158
    (values
     (every #'evenp v1)
     (notnot (every 'evenp v2))))
  nil t)

(deftest every.24
  (loop for i from 1 to 40
sds's avatar
sds committed
159 160 161 162 163 164 165 166 167 168
        for type = `(unsigned-byte ,i)
        unless
        (let* ((v1 (make-array '(10) :initial-contents '(1 1 0 0 0 0 1 1 1 1)
                               :element-type type))
               (v2 (make-array '(4) :displaced-to v1
                               :displaced-index-offset 2
                               :element-type type)))
          (and (not (every 'evenp v1))
               (every #'evenp v2)))
        collect i)
169 170 171 172
  nil)

(deftest every.25
  (loop for i from 1 to 40
sds's avatar
sds committed
173 174 175 176 177 178 179 180 181 182
        for type = `(signed-byte ,i)
        unless
        (let* ((v1 (make-array '(10) :initial-contents '(-1 -1 0 0 0 0 -1 -1 -1 -1)
                               :element-type type))
               (v2 (make-array '(4) :displaced-to v1
                               :displaced-index-offset 2
                               :element-type type)))
          (and (not (every 'evenp v1))
               (every #'evenp v2)))
        collect i)
183 184 185 186 187
  nil)

(deftest every.26
  (let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
    (loop for i from 0 to 6
sds's avatar
sds committed
188 189 190 191
          for s2 = (make-array '(2) :element-type 'character
                               :displaced-to s1
                               :displaced-index-offset i)
          collect (notnot (every 'alpha-char-p s2))))
192 193 194 195 196
  (nil nil t t nil nil nil))

(deftest every.27
  (let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'base-char)))
    (loop for i from 0 to 6
sds's avatar
sds committed
197 198 199 200
          for s2 = (make-array '(2) :element-type 'base-char
                               :displaced-to s1
                               :displaced-index-offset i)
          collect (notnot (every 'alpha-char-p s2))))
201 202 203 204 205 206
  (nil nil t t nil nil nil))

;;; adjustable vectors

(deftest every.28
  (let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
sds's avatar
sds committed
207
                       :adjustable t)))
208 209 210 211 212 213 214 215 216
    (values
     (notnot (every #'plusp v))
     (progn
       (adjust-array v '(11) :initial-element -1)
       (every #'plusp v))))
  t nil)

(deftest every.29
  (let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
sds's avatar
sds committed
217 218
                       :fill-pointer 10
                       :adjustable t)))
219 220 221 222 223 224 225 226 227 228 229
    (values
     (notnot (every #'plusp v))
     (progn
       (adjust-array v '(11) :initial-element -1)
       (every #'plusp v))))
  t t)

;;; Float, complex vectors

(deftest every.30
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
230 231 232 233 234 235
        for v = (make-array '(6)
                            :element-type type
                            :initial-contents
                            (mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6)))
        unless (every #'plusp v)
        collect (list type v))
236 237 238 239
  nil)

(deftest every.31
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
240 241 242 243 244 245 246
        for v = (make-array '(6)
                            :element-type type
                            :fill-pointer 5
                            :initial-contents
                            (mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 -1)))
        unless (every #'plusp v)
        collect (list type v))
247 248 249 250
  nil)

(deftest every.32
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
251 252 253 254 255 256 257
        for ctype = `(complex ,type)
        for v = (make-array '(6)
                            :element-type ctype
                            :initial-contents
                            (mapcar #'(lambda (x) (complex x (coerce x type))) '(1 2 3 4 5 6)))
        unless (every #'complexp v)
        collect (list type v))
258 259
  nil)

260 261
;;; Order of arguments

262
(deftest every.order.1
263 264 265
  (let ((i 0) x y)
    (values
     (every (progn (setf x (incf i)) #'null)
sds's avatar
sds committed
266
            (progn (setf y (incf i)) '(nil nil a nil)))
267 268 269
     i x y))
  nil 2 1 2)

270 271 272 273
(deftest every.order.2
  (let ((i 0) x y z)
    (values
     (every (progn (setf x (incf i)) #'equal)
sds's avatar
sds committed
274 275
            (progn (setf y (incf i)) '(nil nil a nil))
            (progn (setf z (incf i)) '(nil nil a b)))
276 277 278
     i x y z))
  nil 3 1 2 3)

279 280 281
;;; Error cases

(deftest every.error.1
282
  (check-type-error #'(lambda (x) (every x '(a b c)))
sds's avatar
sds committed
283
                    #'(lambda (x) (typep x '(or function symbol))))
284
  nil)
285

286
(deftest every.error.2
287
  (check-type-error #'(lambda (x) (every #'null x))
sds's avatar
sds committed
288
                    #'(lambda (x) (typep x 'sequence)))
289
  nil)
290

291
(deftest every.error.3
292
  (check-type-error #'(lambda (x) (every #'eq () x))
sds's avatar
sds committed
293
                    #'(lambda (x) (typep x 'sequence)))
294
  nil)
295

296
(deftest every.error.8
297 298
  (signals-error (every) program-error)
  t)
299 300

(deftest every.error.9
301 302
  (signals-error (every #'null) program-error)
  t)
303 304

(deftest every.error.10
305 306
  (signals-error (locally (every 1 '(a b c)) t) type-error)
  t)
307 308

(deftest every.error.11
309 310
  (signals-error (every #'cons '(a b c)) program-error)
  t)
311 312

(deftest every.error.12
313 314
  (signals-error (every #'cons '(a b c) '(1 2 3) '(4 5 6)) program-error)
  t)
315 316

(deftest every.error.13
317 318 319
  (signals-error (every #'car '(a b c)) type-error)
  t)

320 321 322
(deftest every.error.14
  (signals-error (every #'identity '(1 2 3 . 4)) type-error)
  t)