random-type-prop-tests-08.lsp 10.7 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7 8 9 10
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Mar 13 18:31:57 2005
;;;; Contains: Random type prop tests, part 8 (sequences)

(in-package :cl-test)

(def-type-prop-test copy-seq 'copy-seq '((or vector list)) 1)

(def-type-prop-test elt 'elt (list '(or vector list)
sds's avatar
sds committed
11 12
                                   #'(lambda (x) (let ((len (length x)))
                                                   (and (> len 0) `(integer 0 (,len))))))
pfdietz's avatar
pfdietz committed
13
  2)
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

(defmacro rfill (x y &rest other-args)
  `(fill ,y ,x ,@other-args))

(def-type-prop-test fill.1 'rfill
  (list t #'make-random-sequence-type-containing)
  2 :replicate '(nil t))

(def-type-prop-test fill.2 'rfill
  (list 'integer #'make-random-sequence-type-containing)
  2 :replicate '(nil t))

(def-type-prop-test fill.3 'rfill
  (list 'character #'make-random-sequence-type-containing)
  2 :replicate '(nil t))

(def-type-prop-test fill.4 'rfill
  (list t #'make-random-sequence-type-containing
sds's avatar
sds committed
32 33 34 35
        '(eql :start)
        #'(lambda (v s k1) (declare (ignore v k1))
            (let ((len (length s)))
              `(integer 0 ,len))))
36 37 38 39
  4 :replicate '(nil t nil nil))

(def-type-prop-test fill.5 'rfill
  (list t #'make-random-sequence-type-containing
sds's avatar
sds committed
40 41 42 43
        '(eql :end)
        #'(lambda (v s k1) (declare (ignore v k1))
            (let ((len (length s)))
              `(integer 0 ,len))))
44 45 46 47
  4 :replicate '(nil t nil nil))

(def-type-prop-test fill.6 'rfill
  (list t #'make-random-sequence-type-containing
sds's avatar
sds committed
48 49 50 51 52 53 54 55 56
        '(eql :start)
        #'(lambda (v s k1) (declare (ignore v k1))
            (let ((len (length s)))
              `(integer 0 ,len)))
        '(eql :end)
        #'(lambda (v s k1 start k2)
            (declare (ignore v k1 k2))
            (let ((len (length s)))
              `(integer ,start ,len))))
57 58 59 60 61 62 63 64 65 66
  6 :replicate '(nil t nil nil nil nil))

;;; make-sequence tests here

(def-type-prop-test subseq.1 'subseq
  (list 'sequence #'(lambda (s) `(integer 0 ,(length s))))
  2)

(def-type-prop-test subseq.2 'subseq
  (list 'sequence #'(lambda (s) `(integer 0 ,(length s)))
sds's avatar
sds committed
67
        #'(lambda (s start) `(integer ,start ,(length s))))
68 69 70
  3)

;;; map tests here
71 72 73

(def-type-prop-test map.1 'map
  (list '(member list vector)
sds's avatar
sds committed
74 75
        '(member list #.#'list)
        '(or list vector))
76 77 78 79
  3)

(def-type-prop-test map.2 'map
  (list '(member list vector)
sds's avatar
sds committed
80 81 82
        '(member list #.#'list)
        '(or list vector)
        '(or list vector))
83 84 85 86
  4)

(def-type-prop-test map.3 'map
  (list '(member list vector)
sds's avatar
sds committed
87 88 89 90
        '(member list #.#'list)
        '(or list vector)
        '(or list vector)
        '(or list vector))
91 92 93 94
  5)

(def-type-prop-test map.4 'map
  (list '(member list vector (vector (unsigned-byte 32)))
sds's avatar
sds committed
95 96
        '(member 1+ #.#'1+)
        `(or ,@(loop for i from 1 to 31 collect `(vector (unsigned-byte ,i)))))
97 98 99 100
  3)

(def-type-prop-test map.5 'map
  (list `(member ,@(loop for i from 1 to 32 collect `(vector (unsigned-byte ,i))))
sds's avatar
sds committed
101 102 103 104 105
        '(member 1+ #.#'1+)
        #'(lambda (type fun)
            (declare (ignore fun))
            (let ((i (cadadr type)))
              `(or ,@(loop for j from i to 32 collect `(vector (integer 0 ,(- (ash 1 i) 2))))))))
106 107 108 109
  3)



110
;;; map-into tests here
111 112 113

(def-type-prop-test map-into.1 'map-into
  (list '(or list (vector t))
sds's avatar
sds committed
114 115
        '(member list #.#'list)
        '(or list vector))
116 117 118 119
  3 :replicate '(t nil nil))

(def-type-prop-test map-into.2 'map-into
  (list '(or list (vector t))
sds's avatar
sds committed
120 121 122
        '(member list #.#'list)
        '(or list vector)
        '(or list vector))
123 124
  4 :replicate '(t nil nil nil))

125 126 127 128 129 130 131 132
;;; reduce tests here

(def-type-prop-test count.1 'count '(t sequence) 2)
(def-type-prop-test count.2 'count
  (list t #'make-random-sequence-type-containing)
  2)
(def-type-prop-test count.3 'count
  (list t #'make-random-sequence-type-containing
sds's avatar
sds committed
133 134 135
        '(eql :start)
        #'(lambda (x s k1) (declare (ignore x k1))
            `(integer 0 ,(length s))))
136 137 138
  4)
(def-type-prop-test count.4 'count
  (list t #'make-random-sequence-type-containing
sds's avatar
sds committed
139 140 141
        '(eql :end)
        #'(lambda (x s k1) (declare (ignore x k1))
            `(integer 0 ,(length s))))
142 143 144
  4)
(def-type-prop-test count.5 'count
  (list t #'make-random-sequence-type-containing
sds's avatar
sds committed
145 146 147 148 149 150
        '(eql :start)
        #'(lambda (x s k1) (declare (ignore x k1))
            `(integer 0 ,(length s)))
        '(eql :end)
        #'(lambda (x s k1 start k2) (declare (ignore x k1 k2))
            `(integer ,start ,(length s))))
151 152
  6)

153 154
(def-type-prop-test count.6 'count
  (list '(or short-float single-float double-float long-float)
sds's avatar
sds committed
155 156 157 158 159 160 161
        #'(lambda (f) `(vector (or ,(typecase f
                                      (short-float 'short-float)
                                      (single-float 'single-float)
                                      (double-float 'double-float)
                                      (long-float 'long-float)
                                      (t 'float))
                                   (eql ,f)))))
162 163 164 165 166 167
  2)

(def-type-prop-test count.7 'count '(bit (vector bit)) 2)
(def-type-prop-test count.8 'count '((unsigned-byte 2) (vector (unsigned-byte 2))) 2)
(def-type-prop-test count.9 'count '((unsigned-byte 4) (vector (unsigned-byte 4))) 2)
(def-type-prop-test count.10 'count '((unsigned-byte 8) (vector (unsigned-byte 8))) 2)
sds's avatar
sds committed
168

169 170 171 172 173

;;; count-if tests

(def-type-prop-test count-if.1 'count-if
  (list (let ((funs '(numberp rationalp realp floatp complexp
sds's avatar
sds committed
174
                      symbolp identity null functionp listp consp
175
                      arrayp vectorp simple-vector-p
sds's avatar
sds committed
176 177 178 179
                      stringp simple-string-p
                      bit-vector-p simple-bit-vector-p)))
          `(member ,@funs ,@(mapcar #'symbol-function funs)))
        '(or list vector))
180 181 182 183
  2)

(def-type-prop-test count-if.2 'count-if
  (list (let ((funs '(numberp rationalp realp floatp complexp
sds's avatar
sds committed
184
                      symbolp identity null functionp listp consp
185
                      arrayp vectorp simple-vector-p
sds's avatar
sds committed
186 187 188 189 190 191 192
                      stringp simple-string-p
                      bit-vector-p simple-bit-vector-p)))
          `(member ,@funs ,@(mapcar #'symbol-function funs)))
        '(or list vector)
        '(eql :key)
        (let ((key-funs '(identity not null)))
          `(member ,@key-funs ,@(mapcar #'symbol-function key-funs))))
193 194 195 196
  4)


;;; Put count-if-not tests here
sds's avatar
sds committed
197

198 199 200 201 202 203 204 205 206 207 208 209

(def-type-prop-test length.1 'length '(sequence) 1)

(def-type-prop-test reverse.1 'reverse '(sequence) 1)
(def-type-prop-test nreverse.1 'nreverse '(sequence) 1 :replicate '(t))

(def-type-prop-test sort.1 'sort
  `((vector bit) (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) 2
  :replicate '(t nil))

(def-type-prop-test sort.2 'sort
  `((or (vector (unsigned-byte 2))
sds's avatar
sds committed
210 211 212 213 214 215
        (vector (unsigned-byte 3))
        (vector (unsigned-byte 4))
        (vector (unsigned-byte 5))
        (vector (unsigned-byte 6))
        (vector (unsigned-byte 7))
        (vector (unsigned-byte 8)))
216 217
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))
sds's avatar
sds committed
218

219 220
(def-type-prop-test sort.3 'sort
  `((or (vector (unsigned-byte 10))
sds's avatar
sds committed
221 222 223
        (vector (unsigned-byte 13))
        (vector (unsigned-byte 15))
        (vector (unsigned-byte 16)))
224 225 226 227 228
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test sort.4 'sort
  `((or (vector (unsigned-byte 20))
sds's avatar
sds committed
229 230 231 232
        (vector (unsigned-byte 24))
        (vector (unsigned-byte 28))
        (vector (unsigned-byte 31))
        (vector (unsigned-byte 32)))
233 234 235 236 237
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test sort.5 'sort
  `((or (vector (signed-byte 2))
sds's avatar
sds committed
238 239 240 241 242 243
        (vector (signed-byte 3))
        (vector (signed-byte 4))
        (vector (signed-byte 5))
        (vector (signed-byte 6))
        (vector (signed-byte 7))
        (vector (signed-byte 8)))
244 245 246 247 248
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test sort.6 'sort
  `((or (vector (signed-byte 10))
sds's avatar
sds committed
249 250 251
        (vector (signed-byte 13))
        (vector (signed-byte 15))
        (vector (signed-byte 16)))
252 253 254 255 256
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test sort.7 'sort
  `((or (vector (signed-byte 20))
sds's avatar
sds committed
257 258 259 260
        (vector (signed-byte 24))
        (vector (signed-byte 28))
        (vector (signed-byte 31))
        (vector (signed-byte 32)))
261 262 263 264 265
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test sort.8 'sort
  `((or (vector short-float)
sds's avatar
sds committed
266 267 268
        (vector single-float)
        (vector double-float)
        (vector long-float))
269 270
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))
271 272 273 274 275 276 277 278 279

;;; Stable sort

(def-type-prop-test stable-sort.1 'stable-sort
  `((vector bit) (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) 2
  :replicate '(t nil))

(def-type-prop-test stable-sort.2 'stable-sort
  `((or (vector (unsigned-byte 2))
sds's avatar
sds committed
280 281 282 283 284 285
        (vector (unsigned-byte 3))
        (vector (unsigned-byte 4))
        (vector (unsigned-byte 5))
        (vector (unsigned-byte 6))
        (vector (unsigned-byte 7))
        (vector (unsigned-byte 8)))
286 287
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))
sds's avatar
sds committed
288

289 290
(def-type-prop-test stable-sort.3 'stable-sort
  `((or (vector (unsigned-byte 10))
sds's avatar
sds committed
291 292 293
        (vector (unsigned-byte 13))
        (vector (unsigned-byte 15))
        (vector (unsigned-byte 16)))
294 295 296 297 298
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test stable-sort.4 'stable-sort
  `((or (vector (unsigned-byte 20))
sds's avatar
sds committed
299 300 301 302
        (vector (unsigned-byte 24))
        (vector (unsigned-byte 28))
        (vector (unsigned-byte 31))
        (vector (unsigned-byte 32)))
303 304 305 306 307
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test stable-sort.5 'stable-sort
  `((or (vector (signed-byte 2))
sds's avatar
sds committed
308 309 310 311 312 313
        (vector (signed-byte 3))
        (vector (signed-byte 4))
        (vector (signed-byte 5))
        (vector (signed-byte 6))
        (vector (signed-byte 7))
        (vector (signed-byte 8)))
314 315 316 317 318
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test stable-sort.6 'stable-sort
  `((or (vector (signed-byte 10))
sds's avatar
sds committed
319 320 321
        (vector (signed-byte 13))
        (vector (signed-byte 15))
        (vector (signed-byte 16)))
322 323 324 325 326
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test stable-sort.7 'stable-sort
  `((or (vector (signed-byte 20))
sds's avatar
sds committed
327 328 329 330
        (vector (signed-byte 24))
        (vector (signed-byte 28))
        (vector (signed-byte 31))
        (vector (signed-byte 32)))
331 332 333 334 335
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test stable-sort.8 'stable-sort
  `((or (vector short-float)
sds's avatar
sds committed
336 337 338
        (vector single-float)
        (vector double-float)
        (vector long-float))
339 340 341 342 343 344 345 346 347 348
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
  2 :replicate '(t nil))

(def-type-prop-test stable-sort.9 'stable-sort
  `((vector (cons (integer 0 4) (eql nil)))
    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)
    (eql :key)
    (member car ,#'car))
  4 :replicate '(t nil nil nil)
  :test #'equalp-and-eql-elements)