notany.lsp 8.61 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Oct 18 07:14:14 2002
;;;; Contains: Tests for NOTANY

Daniel Kochmański's avatar
Daniel Kochmański committed
6

7 8

(deftest notany.1
9
  (not-mv (notany #'identity nil))
10 11 12
  nil)

(deftest notany.2
13
  (not-mv (notany #'identity #()))
14 15 16 17 18 19
  nil)

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

(deftest notany.4
25
  (not-mv (notany #'/= '(1 2 3 4) '(1 2 3 4 5)))
26 27 28
  nil)

(deftest notany.5
29
  (not-mv (notany #'/= '(1 2 3 4 5) '(1 2 3 4)))
30 31 32 33 34 35 36
  nil)

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

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

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

(deftest notany.9
51
  (not-mv (notany #'zerop #*11111111111111))
52 53 54
  nil)

(deftest notany.10
55
  (not-mv (notany #'zerop #*))
56 57 58 59 60 61 62
  nil)

(deftest notany.11
  (notany #'zerop #*1111111011111)
  nil)

(deftest notany.12
63
  (not-mv (notany #'(lambda (x) (not (eql x #\a))) "aaaaaaaa"))
64 65 66
  nil)

(deftest notany.13
67
  (not-mv (notany #'(lambda (x) (eql x #\a)) ""))
68 69 70 71 72 73 74
  nil)

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

(deftest notany.15
75
  (not-mv (notany 'null '(1 2 3 4)))
76 77 78 79 80 81
  nil)

(deftest notany.16
  (notany 'null '(1 2 3 nil 5))
  nil)

82 83 84 85
;;; Other specialized sequences

(deftest notany.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 (notany #'plusp v))))
90 91 92 93
  (nil nil nil nil nil t t t t t))

(deftest notany.18
  (loop for i from 1 to 40
sds's avatar
sds committed
94 95 96 97 98 99 100 101 102 103 104
        for type = `(unsigned-byte ,i)
        unless
        (let ((v (make-array '(10) :initial-contents (loop for j in '(0 0 0 0 1 2 3 4 5 6)
                                                           collect (mod j (ash 1 i)))
                             :element-type type
                             :fill-pointer 4)))
          (equal (loop for j from 0 to 9
                       do (setf (fill-pointer v) j)
                       collect (not (notany #'plusp v)))
                 '(nil nil nil nil nil t t t t t)))
        collect i)
105 106 107 108
  nil)

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

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

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

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

(deftest notany.23
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
150 151 152 153 154 155
        for v = (make-array '(9)
                            :element-type type
                            :initial-contents
                            (mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6 0 8 3)))
        when (notany #'zerop v)
        collect (list type v))
156 157 158 159
  nil)

(deftest notany.24
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
160 161 162 163 164 165 166
        for v = (make-array '(9)
                            :element-type type
                            :fill-pointer 6
                            :initial-contents
                            (mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6 0 8 3)))
        unless (notany #'zerop v)
        collect (list type v))
167 168 169 170
  nil)

(deftest notany.25
  (loop for type in '(short-float single-float double-float long-float)
sds's avatar
sds committed
171 172 173 174 175 176 177
        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 (notany (complement #'complexp) v)
        collect (list type v))
178 179 180 181 182 183
  nil)

;;; Displaced vectors

(deftest notany.26
  (let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1)))
sds's avatar
sds committed
184 185
         (v2 (make-array '(4) :displaced-to v1
                         :displaced-index-offset 2)))
186 187 188 189 190 191 192
    (values
     (notany #'oddp v1)
     (notnot (notany #'oddp v2))))
  nil t)

(deftest notany.27
  (loop for i from 1 to 40
sds's avatar
sds committed
193 194 195 196 197 198 199 200 201 202
        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 (notany 'oddp v1))
               (notany #'oddp v2)))
        collect i)
203 204 205 206
  nil)

(deftest notany.28
  (loop for i from 1 to 40
sds's avatar
sds committed
207 208 209 210 211 212 213 214 215 216
        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 (notany 'oddp v1))
               (notany #'oddp v2)))
        collect i)
217 218 219 220 221
  nil)

(deftest notany.29
  (let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
    (loop for i from 0 to 6
sds's avatar
sds committed
222 223 224 225
          for s2 = (make-array '(2) :element-type 'character
                               :displaced-to s1
                               :displaced-index-offset i)
          collect (not (notany 'digit-char-p s2))))
226 227 228 229 230
  (t t nil nil t t t))

(deftest notany.30
  (let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'base-char)))
    (loop for i from 0 to 6
sds's avatar
sds committed
231 232 233 234
          for s2 = (make-array '(2) :element-type 'base-char
                               :displaced-to s1
                               :displaced-index-offset i)
          collect (not (notany 'digit-char-p s2))))
235 236 237 238
  (t t nil nil t t t))

(deftest notany.31
  (let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
sds's avatar
sds committed
239
                       :adjustable t)))
240 241 242 243 244 245 246 247 248
    (values
     (notnot (notany #'minusp v))
     (progn
       (adjust-array v '(11) :initial-element -1)
       (notany #'minusp v))))
  t nil)

(deftest notany.32
  (let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
sds's avatar
sds committed
249 250
                       :fill-pointer 10
                       :adjustable t)))
251 252 253 254 255 256 257 258
    (values
     (notnot (notany #'minusp v))
     (progn
       (adjust-array v '(11) :initial-element -1)
       (notnot (notany #'minusp v)))))
  t t)


259 260 261 262
(deftest notany.order.1
  (let ((i 0) a b)
    (values
     (not (notany (progn (setf a (incf i)) 'null)
sds's avatar
sds committed
263
                  (progn (setf b (incf i)) '(a b c))))
264 265 266
     i a b))
  nil 2 1 2)

267 268 269
;;; Error cases

(deftest notany.error.1
pfdietz's avatar
pfdietz committed
270
  (check-type-error #'(lambda (x) (notany x '(a b c)))
sds's avatar
sds committed
271
                    (typef '(or symbol function)))
pfdietz's avatar
pfdietz committed
272
  nil)
273

274
(deftest notany.error.4
pfdietz's avatar
pfdietz committed
275 276
  (check-type-error #'(lambda (x) (notany #'null x)) #'sequencep)
  nil)
277

278
(deftest notany.error.7
pfdietz's avatar
pfdietz committed
279 280
  (check-type-error #'(lambda (x) (notany #'eql () x)) #'sequencep)
  nil)
281 282

(deftest notany.error.8
283 284
  (signals-error (notany) program-error)
  t)
285 286

(deftest notany.error.9
287 288
  (signals-error (notany #'null) program-error)
  t)
289 290

(deftest notany.error.10
291 292
  (signals-error (locally (notany 1 '(a b c)) t) type-error)
  t)
293 294

(deftest notany.error.11
295 296
  (signals-error (notany #'cons '(a b c)) program-error)
  t)
297 298

(deftest notany.error.12
299 300
  (signals-error (notany #'cons '(a b c) '(1 2 4) '(g h j)) program-error)
  t)
301 302

(deftest notany.error.13
303
  (signals-error (notany #'car '(a b c)) type-error)
sds's avatar
sds committed
304
  t)