random-type-prop-tests-06.lsp 7.83 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Mar 13 15:33:55 2005
;;;; Contains: Random type prop tests, part 6 (arrays)

(in-package :cl-test)

(def-type-prop-test adjustable-array-p 'adjustable-array-p '(array) 1)

(def-type-prop-test aref.0 'aref '((array * nil)) 1)
(def-type-prop-test aref.1 'aref (list '(array * (*)) (index-type-for-dim 0)) 2)
(def-type-prop-test aref.2 'aref (list '(array * (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
(def-type-prop-test aref.3 'aref (list '(array * (* * *))
sds's avatar
sds committed
14
                                       (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
  4)

(def-type-prop-test array-dimension 'array-dimension
  (list 'array #'(lambda (x) (let ((r (array-rank x))) (and (> r 0) `(integer 0 (,r))))))
  2)
(def-type-prop-test array-dimensions 'array-dimensions '(array) 1)
(def-type-prop-test array-element-type 'array-element-type '(array) 1)
(def-type-prop-test array-has-fill-pointer-p.1 'array-has-fill-pointer-p '(array) 1)
(def-type-prop-test array-has-fill-pointer-p.2 'array-has-fill-pointer-p '(vector) 1)
(def-type-prop-test array-displacement.1 'array-displacement '(array) 1)
(def-type-prop-test array-displacement.2 'array-displacement '(vector) 1)

(def-type-prop-test array-in-bounds-p.0 'array-in-bounds-p '((array * nil)) 1)
(def-type-prop-test array-in-bounds-p.1 'array-in-bounds-p (list '(array * (*)) (index-type-for-dim 0)) 2)
(def-type-prop-test array-in-bounds-p.2 'array-in-bounds-p
  (list '(array * (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
(def-type-prop-test array-in-bounds-p.3 'array-in-bounds-p
  (list '(array * (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
  4)
(def-type-prop-test array-in-bounds-p.4 'array-in-bounds-p '((array * (*)) integer) 2)
(def-type-prop-test array-in-bounds-p.5 'array-in-bounds-p '((array * (* *)) integer integer) 3)
(def-type-prop-test array-in-bounds-p.6 'array-in-bounds-p '((array * (* * *)) integer integer integer) 4)
(def-type-prop-test array-rank 'array-rank '(array) 1)

(def-type-prop-test array-row-major-index.0 'array-row-major-index '((array * nil)) 1)
(def-type-prop-test array-row-major-index.1 'array-row-major-index (list '(array * (*)) (index-type-for-dim 0)) 2)
(def-type-prop-test array-row-major-index.2 'array-row-major-index
  (list '(array * (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
(def-type-prop-test array-row-major-index.3 'array-row-major-index
  (list '(array * (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
  4)
(def-type-prop-test array-total-size 'array-total-size '(array) 1)

(def-type-prop-test arrayp 'arrayp '(t) 1)

(def-type-prop-test fill-pointer '(lambda (x) (and (array-has-fill-pointer-p x) (fill-pointer x))) '(vector) 1)

(def-type-prop-test row-major-aref 'row-major-aref
  (list 'array #'(lambda (a) (let ((s (array-total-size a))) (and (> s 0) `(integer 0 (,s))))))
  2)

(def-type-prop-test upgraded-array-element-type 'upgraded-array-element-type
  (list #'(lambda () (let ((x (make-random-element-of-type t)))
sds's avatar
sds committed
58
                       `(eql ,(make-random-type-containing x)))))
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
  1)

(def-type-prop-test simple-vector-p.1 'simple-vector-p '(t) 1)
(def-type-prop-test simple-vector-p.2 'simple-vector-p '(vector) 1)

(def-type-prop-test svref 'svref (list 'simple-vector (index-type-for-dim 0)) 2)
(def-type-prop-test vector 'vector nil 1 :rest-type t :maxargs 10)
(def-type-prop-test vectorp.1 'vectorp '(t) 1)
(def-type-prop-test vectorp.2 'vectorp '(array) 1)

(def-type-prop-test bit.1 'bit (list '(array bit (*)) (index-type-for-dim 0)) 2)
(def-type-prop-test bit.2 'bit (list '(array bit (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
(def-type-prop-test bit.3 'bit
  (list '(array bit (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
  4)

(def-type-prop-test sbit.1 'sbit (list '(simple-array bit (*)) (index-type-for-dim 0)) 2)
(def-type-prop-test sbit.2 'sbit (list '(simple-array bit (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
(def-type-prop-test sbit.3 'sbit
  (list '(simple-array bit (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
  4)


(def-type-prop-test bit-and.1 'bit-and (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
sds's avatar
sds committed
83
                                                                          `(array bit ,dims))))
84 85 86 87 88
  2)
(def-type-prop-test bit-and.2 'bit-and
  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
  3)
(def-type-prop-test bit-andc1.1 'bit-andc1 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
sds's avatar
sds committed
89
                                                                          `(array bit ,dims))))
90 91 92 93 94
  2)
(def-type-prop-test bit-andc1.2 'bit-andc1
  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
  3)
(def-type-prop-test bit-andc2.1 'bit-andc2 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
sds's avatar
sds committed
95
                                                                          `(array bit ,dims))))
96 97 98 99 100
  2)
(def-type-prop-test bit-andc2.2 'bit-andc2
  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
  3)
(def-type-prop-test bit-ior.1 'bit-ior (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
sds's avatar
sds committed
101
                                                                          `(array bit ,dims))))
102 103 104 105 106
  2)
(def-type-prop-test bit-ior.2 'bit-ior
  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
  3)
(def-type-prop-test bit-orc1.1 'bit-orc1 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
sds's avatar
sds committed
107
                                                                          `(array bit ,dims))))
108 109 110 111 112
  2)
(def-type-prop-test bit-orc1.2 'bit-orc1
  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
  3)
(def-type-prop-test bit-orc2.1 'bit-orc2 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
sds's avatar
sds committed
113
                                                                          `(array bit ,dims))))
114 115 116 117 118
  2)
(def-type-prop-test bit-orc2.2 'bit-orc2
  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
  3)
(def-type-prop-test bit-eqv.1 'bit-eqv (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
sds's avatar
sds committed
119
                                                                          `(array bit ,dims))))
120 121 122 123 124
  2)
(def-type-prop-test bit-eqv.2 'bit-eqv
  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
  3)
(def-type-prop-test bit-xor.1 'bit-xor (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
sds's avatar
sds committed
125
                                                                          `(array bit ,dims))))
126 127 128 129 130
  2)
(def-type-prop-test bit-xor.2 'bit-xor
  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
  3)
(def-type-prop-test bit-nand.1 'bit-nand (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
sds's avatar
sds committed
131
                                                                          `(array bit ,dims))))
132 133 134 135 136
  2)
(def-type-prop-test bit-nand.2 'bit-nand
  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
  3)
(def-type-prop-test bit-nor.1 'bit-nor (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
sds's avatar
sds committed
137
                                                                          `(array bit ,dims))))
138 139 140 141 142 143 144 145 146
  2)
(def-type-prop-test bit-nor.2 'bit-nor
  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
  3)
(def-type-prop-test bit-not.1 'bit-not '((array bit)) 1)
(def-type-prop-test bit-not.2 'bit-not '((array bit) null) 2)

(def-type-prop-test bit-vector-p 'bit-vector-p '(t) 1)
(def-type-prop-test simple-bit-vector-p 'simple-bit-vector-p '(t) 1)