notevery.lsp 8.65 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Oct 18 07:20:12 2002
;;;; Contains: Tests for NOTEVERY

6

7 8 9 10 11 12 13 14 15 16 17 18 19

(deftest notevery.1
  (notevery #'identity nil)
  nil)

(deftest notevery.2
  (notevery #'identity #())
  nil)

(deftest notevery.3
  (let ((count 0))
    (values
     (not (notevery #'(lambda (x) (incf count) (< x 10))
sds's avatar
sds committed
20
                    '(1 2 4 13 5 1)))
21 22 23 24 25 26 27 28 29 30 31 32
     count))
  nil 4)

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

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

(deftest notevery.6
33
  (not-mv (notevery #'= '(1 2 3 4 5) '(1 2 3 4 6)))
34 35 36 37
  nil)

(deftest notevery.7
  (notevery #'(lambda (x y) (or x y))
sds's avatar
sds committed
38
            '(nil t t nil t) #(t nil t t nil nil))
39 40 41 42
  nil)

(deftest notevery.8
  (let ((x '(1))
sds's avatar
sds committed
43
        (args nil))
44 45
    (not
     (loop for i from 1 below (1- (min 100 call-arguments-limit))
sds's avatar
sds committed
46 47
           do (push x args)
           always (not (apply #'notevery #'= args)))))
48 49 50 51 52 53 54 55 56 57 58
  nil)

(deftest notevery.9
  (notevery #'zerop #*000000000000)
  nil)

(deftest notevery.10
  (notevery #'zerop #*)
  nil)

(deftest notevery.11
59
  (not-mv (notevery #'zerop #*0000010000))
60 61 62 63 64 65 66 67 68 69 70
  nil)

(deftest notevery.12
  (notevery #'(lambda (x) (eql x #\a)) "aaaaaaaa")
  nil)

(deftest notevery.13
  (notevery #'(lambda (x) (eql x #\a)) "")
  nil)

(deftest notevery.14
71
  (not-mv (notevery #'(lambda (x) (eql x #\a)) "aaaaaabaaaa"))
72 73 74
  nil)

(deftest notevery.15
75
  (not-mv (notevery 'null '(nil nil t nil)))
76 77 78 79 80 81
  nil)

(deftest notevery.16
  (notevery 'null '(nil nil nil nil))
  nil)

82 83 84 85
;;; Other specialized sequences

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

(deftest notevery.18
  (loop for i from 1 to 40
sds's avatar
sds committed
94 95 96 97 98 99 100 101 102 103
        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 (not (notevery #'zerop v)))
                 '(t t t t t nil nil nil nil nil)))
        collect i)
104 105 106 107
  nil)

(deftest notevery.19
  (loop for i from 1 to 40
sds's avatar
sds committed
108 109 110 111 112 113 114 115 116 117
        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 (not (notevery #'zerop v)))
                 '(t t t t t nil nil nil nil nil)))
        collect i)
118 119 120 121
  nil)

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

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

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

;;; Displaced vectors

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

(deftest notevery.24
  (loop for i from 1 to 40
sds's avatar
sds committed
160 161 162 163 164 165 166 167 168 169
        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 (notevery 'evenp v1)
               (not (notevery #'evenp v2))))
        collect i)
170 171 172 173
  nil)

(deftest notevery.25
  (loop for i from 1 to 40
sds's avatar
sds committed
174 175 176 177 178 179 180 181 182 183
        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 (notevery 'evenp v1)
               (not (notevery #'evenp v2))))
        collect i)
184 185 186 187 188
  nil)

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

(deftest notevery.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
198 199 200 201
          for s2 = (make-array '(2) :element-type 'base-char
                               :displaced-to s1
                               :displaced-index-offset i)
          collect (not (notevery 'alpha-char-p s2))))
202 203 204 205 206 207
  (nil nil t t nil nil nil))

;;; adjustable vectors

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

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

;;; Float, complex vectors

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

(deftest notevery.31
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
241 242 243 244 245 246 247
        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)))
        when (notevery #'plusp v)
        collect (list type v))
248 249 250 251
  nil)

(deftest notevery.32
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
252 253 254 255 256 257 258
        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)))
        when (notevery #'complexp v)
        collect (list type v))
259 260 261
  nil)


262 263 264 265
(deftest notevery.order.1
  (let ((i 0) a b)
    (values
     (notevery (progn (setf a (incf i)) #'identity)
sds's avatar
sds committed
266
               (progn (setf b (incf i)) '(a b c d)))
267 268 269
     i a b))
  nil 2 1 2)

270 271 272
;;; Error cases

(deftest notevery.error.1
pfdietz's avatar
pfdietz committed
273
  (check-type-error #'(lambda (x) (notevery x '(a b c)))
sds's avatar
sds committed
274
                    (typef '(or symbol function)))
pfdietz's avatar
pfdietz committed
275
  nil)
276

277
(deftest notevery.error.4
pfdietz's avatar
pfdietz committed
278 279
  (check-type-error #'(lambda (x) (notevery #'null x)) #'sequencep)
  nil)
280

281
(deftest notevery.error.7
pfdietz's avatar
pfdietz committed
282 283
  (check-type-error #'(lambda (x) (notevery #'eql () x)) #'sequencep)
  nil)
284 285

(deftest notevery.error.8
286 287
  (signals-error (notevery) program-error)
  t)
288 289

(deftest notevery.error.9
290 291
  (signals-error (notevery #'null) program-error)
  t)
292 293

(deftest notevery.error.10
294 295
  (signals-error (locally (notevery 1 '(a b c)) t) type-error)
  t)
296 297

(deftest notevery.error.11
298 299
  (signals-error (notevery #'cons '(a b c)) program-error)
  t)
300 301

(deftest notevery.error.12
302 303
  (signals-error (notevery #'cons '(a b c) '(1 2 4) '(g h j)) program-error)
  t)
304 305

(deftest notevery.error.13
306
  (signals-error (notevery #'car '(a b c)) type-error)
sds's avatar
sds committed
307
  t)