Commit 23ed51ad authored by pfdietz's avatar pfdietz

More tests on specialized vectors (integer vectors, integer vectors with...

More tests on specialized vectors (integer vectors, integer vectors with fill/displace/adjust, float and complex vectors)
parent c5ca3b78
......@@ -992,3 +992,56 @@ the condition to go uncaught if it cannot be classified."
:fill ,fill :adjust ,adjust
:base ,base :displace ,displace)))
,@forms))))))))
(defun make-special-integer-vector (contents &key fill adjust displace (etype 'integer))
(let* ((len (length contents))
(min (reduce #'min contents))
(max (reduce #'max contents))
(len2 (if fill (+ len 4) len)))
(unless (and (typep min etype)
(typep max etype))
(setq etype `(integer ,min ,max)))
(if displace
(let ((s0 (make-array (+ len2 5)
:initial-contents
(concatenate 'list
(make-list 2 :initial-element
(if (typep 0 etype) 0 min))
contents
(make-list (if fill 7 3)
:initial-element
(if (typep 1 etype) 1 max)))
:element-type etype)))
(make-array len2 :element-type etype
:adjustable adjust
:fill-pointer (if fill len nil)
:displaced-to s0
:displaced-index-offset 2))
(make-array len2 :element-type etype
:initial-contents
(if fill (concatenate 'list
contents
(make-list 4 :initial-element
(if (typep 2 etype) 2 (floor (+ min max) 2))))
contents)
:fill-pointer (if fill len nil)
:adjustable adjust))))
(defmacro do-special-integer-vectors ((var vec-form &optional ret-form) &body forms)
(let ((vector (gensym))
(fill (gensym "FILL"))
(adjust (gensym "ADJUST"))
(etype (gensym "ETYPE"))
(displace (gensym "DISPLACE")))
`(let ((,vector ,vec-form))
(dolist (,fill '(nil t) ,ret-form)
(dolist (,adjust '(nil t))
(dolist (,etype ',(append (loop for i from 1 to 32 collect `(unsigned-byte ,i))
(loop for i from 2 to 32 collect `(signed-byte ,i))
'(integer)))
(dolist (,displace '(nil t))
(let ((,var (make-special-integer-vector
,vector
:fill ,fill :adjust ,adjust
:etype ,etype :displace ,displace)))
,@forms))))))))
......@@ -170,6 +170,56 @@
(assert (equal (array-element-type s) (array-element-type s2)))))
nil)
;;; Specialized vector tests
(deftest copy-seq.21
(let ((v0 #(1 1 0 1 1 2)))
(do-special-integer-vectors
(v v0 nil)
(let ((v2 (copy-seq v)))
(assert (typep v2 'simple-array))
(assert (equalp v v2))
(assert (equalp v v0))
(assert (equal (array-element-type v) (array-element-type v2))))))
nil)
(deftest copy-seq.22
(let ((v0 #(-1 1 1 0 1 -1 0)))
(do-special-integer-vectors
(v v0 nil)
(let ((v2 (copy-seq v)))
(assert (typep v2 'simple-array))
(assert (equalp v v2))
(assert (equalp v v0))
(assert (equal (array-element-type v) (array-element-type v2))))))
nil)
(deftest copy-seq.23
(loop for type in '(short-float single-float long-float double-float)
for len = 10
for vals = (loop for i from 1 to len collect (coerce i type))
for vec = (make-array len :element-type type :initial-contents vals)
for result = (copy-seq vec)
unless (and (= (length result) len)
(equal (array-element-type vec) (array-element-type result))
(equalp vec result))
collect (list type vals result))
nil)
(deftest copy-seq.24
(loop for etype in '(short-float single-float long-float double-float)
for type = `(complex ,etype)
for len = 10
for vals = (loop for i from 1 to len collect (complex (coerce i etype)
(coerce (- i) etype)))
for vec = (make-array len :element-type type :initial-contents vals)
for result = (copy-seq vec)
unless (and (= (length result) len)
(equal (array-element-type vec) (array-element-type result))
(equalp vec result))
collect (list type vals result))
nil)
;;; Order of evaluation test
(deftest copy-seq.order.1
......
......@@ -271,6 +271,48 @@
)))
3 3 1 1)
;;; Other special vectors
`(deftest count-if-not.special-vector.1
(do-special-integer-vectors
(v #(1 0 1 1 1 0 1 1 1 0 1) nil)
(assert (eql (count-if-not #'plusp v) 3))
(assert (eql (count-if-not #'zerop v) 8))
(assert (eql (count-if-not #'plusp v :start 2) 2))
(assert (eql (count-if-not #'zerop v :end 9) 7)))
nil)
(deftest count-if-not.special-vector.2
(do-special-integer-vectors
(v #(1 3 2 4 7 5 6 1 0 2 4) nil)
(assert (eql (count-if-not #'evenp v) 5))
(assert (eql (count-if-not #'oddp v) 6))
(assert (eql (count-if-not #'plusp v :start 2) 1))
(assert (eql (count-if-not #'zerop v :end 8) 8)))
nil)
(deftest count-if-not.special-vector.3
(loop for etype in '(short-float single-float double-float long-float)
for vals = (loop for e in '(0 1 2 1 3 0 4 5 6 0)
collect (coerce e etype))
for vec = (make-array (length vals) :element-type etype :initial-contents vals)
for result = (count-if-not #'zerop vec)
unless (= result 7)
collect (list etype vals vec result))
nil)
(deftest count-if-not.special-vector.4
(loop for cetype in '(short-float single-float double-float long-float integer rational)
for etype = `(complex ,cetype)
for vals = (loop for e in '(6 1 2 1 3 -4 4 5 6 100)
collect (complex 0 (coerce e cetype)))
for vec = (make-array (length vals) :element-type etype :initial-contents vals)
for result = (count-if-not #'(lambda (x) (< (abs x) 5/2)) vec)
unless (= result 7)
collect (list etype vals vec result))
nil)
;;; tests on bit-vectors
(deftest count-if-not-bit-vector.1
......
......@@ -271,6 +271,48 @@
(count-if #'%f s :start 1 :end 4 :from-end t))))
2 2 1 1 0 0)
;;; Other special vectors
(deftest count-if.special-vector.1
(do-special-integer-vectors
(v #(1 0 1 1 1 0 1 1 1 0 1) nil)
(assert (eql (count-if #'plusp v) 8))
(assert (eql (count-if #'zerop v) 3))
(assert (eql (count-if #'plusp v :start 2) 7))
(assert (eql (count-if #'zerop v :end 9) 2)))
nil)
(deftest count-if.special-vector.2
(do-special-integer-vectors
(v #(1 3 2 4 7 5 6 1 0 2 4) nil)
(assert (eql (count-if #'evenp v) 6))
(assert (eql (count-if #'oddp v) 5))
(assert (eql (count-if #'plusp v :start 2) 8))
(assert (eql (count-if #'zerop v :end 8) 0)))
nil)
(deftest count-if.special-vector.3
(loop for etype in '(short-float single-float double-float long-float)
for vals = (loop for e in '(0 1 2 1 3 0 4 5 6 0)
collect (coerce e etype))
for vec = (make-array (length vals) :element-type etype :initial-contents vals)
for result = (count-if #'zerop vec)
unless (= result 3)
collect (list etype vals vec result))
nil)
(deftest count-if.special-vector.4
(loop for cetype in '(short-float single-float double-float long-float integer rational)
for etype = `(complex ,cetype)
for vals = (loop for e in '(6 1 2 1 3 -4 4 5 6 100)
collect (complex 0 (coerce e cetype)))
for vec = (make-array (length vals) :element-type etype :initial-contents vals)
for result = (count-if #'(lambda (x) (< (abs x) 5/2)) vec)
unless (= result 3)
collect (list etype vals vec result))
nil)
;;; tests on bit-vectors
(deftest count-if-bit-vector.1
......
......@@ -310,6 +310,52 @@
:start 2 :from-end 'yes)
4)
;;; Other specialized vectors
(deftest count.special-vector.1
(do-special-integer-vectors
(v #(0 1 1 0 1 1 1 0 1 1 1 1 0) nil)
(assert (eql (count 0 v) 4))
(assert (eql (count 1 v) 9))
(assert (eql (count 2 v) 0))
(assert (eql (count 0 v :start 2) 3))
(assert (eql (count 1 v :end 11) 8)))
nil)
(deftest count.special-vector.2
(do-special-integer-vectors
(v #(1 2 3 4 5 6 7) nil)
(assert (eql (count 0 v) 0))
(assert (eql (count 1 v) 1))
(assert (eql (count 2 v) 1))
(assert (eql (count 3 v) 1))
(assert (eql (count 4 v) 1))
(assert (eql (count 5 v) 1))
(assert (eql (count 6 v) 1))
(assert (eql (count 7 v) 1)))
nil)
(deftest count.special-vector.3
(loop for etype in '(short-float single-float double-float long-float)
for vals = (loop for e in '(0 1 2 1 3 1 4 5 6 0)
collect (coerce e etype))
for vec = (make-array (length vals) :element-type etype :initial-contents vals)
for result = (count (coerce 1 etype) vec)
unless (= result 3)
collect (list etype vals vec result))
nil)
(deftest count.special-vector.4
(loop for cetype in '(short-float single-float double-float long-float rational integer)
for etype = `(complex ,cetype)
for vals = (loop for e in '(4 1 2 1 3 1 4 5 6 6)
collect (complex 0 (coerce e cetype)))
for vec = (make-array (length vals) :element-type etype :initial-contents vals)
for result = (count (complex 0 (coerce 1 cetype)) vec)
unless (= result 3)
collect (list etype vals vec result))
nil)
;;; Tests on bit vectors
......
......@@ -379,6 +379,55 @@
(assert (char= (elt s 4) #\e)))
nil)
;;; Specialized integer vectors
(deftest elt.special-vectors.1
(do-special-integer-vectors
(v #(1 1 0 1 0 1) nil)
(assert (= (elt v 0) 1))
(assert (= (elt v 1) 1))
(assert (= (elt v 2) 0))
(assert (= (elt v 3) 1))
(assert (= (elt v 4) 0))
(assert (= (elt v 5) 1)))
nil)
(deftest elt.special-vectors.2
(do-special-integer-vectors
(v #(1 2 0 -1 0 3) nil)
(assert (= (elt v 0) 1))
(assert (= (elt v 1) 2))
(assert (= (elt v 2) 0))
(assert (= (elt v 3) -1))
(assert (= (elt v 4) 0))
(assert (= (elt v 5) 3)))
nil)
(deftest elt.special-vectors.3
(loop for type in '(short-float single-float long-float double-float)
for len = 10
for vals = (loop for i from 1 to len collect (coerce i type))
for vec = (make-array len :element-type type :initial-contents vals)
unless (loop for i below len always (eql (elt vec i)
(coerce (1+ i) type)))
collect (list type vals vec))
nil)
(deftest elt.special-vectors.4
(loop for etype in '(short-float single-float long-float double-float
integer rational)
for type = `(complex ,etype)
for len = 10
for vals = (loop for i from 1 to len collect (complex (coerce i etype)
(coerce (- i) etype)))
for vec = (make-array len :element-type type :initial-contents vals)
unless (loop for i below len always (eql (elt vec i)
(elt vals i)))
collect (list type vals vec))
nil)
;;; Error tests
(deftest elt.error.1
......
......@@ -568,3 +568,32 @@
(assert (eq s (fill s #\x :start 1 :end 4)))
(assert (string= s "axxxe")))
nil)
;;; Specialized vector tests
(deftest fill.specialized-vectors.1
(do-special-integer-vectors
(v #(0 1 1 0 1) nil)
(let ((etype (array-element-type v)))
(assert (eq v (fill v 0)))
(assert (equal (array-element-type v) etype)))
(assert (equalp v #(0 0 0 0 0))))
nil)
(deftest fill.specialized-vectors.2
(do-special-integer-vectors
(v #(0 -1 1 0 -1) nil)
(let ((etype (array-element-type v)))
(assert (eq v (fill v 1)))
(assert (equal (array-element-type v) etype)))
(assert (equalp v #(1 1 1 1 1))))
nil)
(deftest fill.specialized-vectors.3
(do-special-integer-vectors
(v #(1 1 1 1 0) nil)
(let ((etype (array-element-type v)))
(assert (eq v (fill v 0 :start 1 :end 3)))
(assert (equal (array-element-type v) etype)))
(assert (equalp v #(1 0 0 1 0))))
nil)
\ No newline at end of file
......@@ -177,6 +177,52 @@
(equalp (make-sequence 'string 5) (make-string 5))
t)
(deftest make-sequence.27
(let ((len 10))
(loop for i from 1 to 40
for etype = `(unsigned-byte ,i)
for type = `(vector ,etype)
for vec = (make-sequence type len :initial-element 0)
unless (and (typep vec type)
(loop for i below len always (eql (elt vec i) 0)))
collect (list i etype type vec)))
nil)
(deftest make-sequence.28
(let ((len 10))
(loop for i from 1 to 40
for etype = `(signed-byte ,i)
for type = `(vector ,etype)
for vec = (make-sequence type len :initial-element 0)
unless (and (typep vec type)
(loop for i below len always (eql (elt vec i) 0)))
collect (list i etype type vec)))
nil)
(deftest make-sequence.29
(let ((len 10))
(loop for etype in '(short-float single-float double-float long-float)
for type = `(vector ,etype)
for elem = (coerce 1 etype)
for vec = (make-sequence type len :initial-element elem)
unless (and (typep vec type)
(loop for i below len always (eql (elt vec i) elem)))
collect (list etype type vec)))
nil)
(deftest make-sequence.30
(let ((len 10))
(loop for cetype in '(short-float single-float double-float long-float
integer rational)
for etype = `(complex ,cetype)
for type = `(vector ,etype)
for elem = (complex (coerce 1 cetype) (coerce -1 cetype))
for vec = (make-sequence type len :initial-element elem)
unless (and (typep vec type)
(loop for i below len always (eql (elt vec i) elem)))
collect (list etype type vec)))
nil)
;;; Keyword tests
(deftest make-sequence.allow-other-keys.1
......
......@@ -361,6 +361,95 @@
8
#*11111100)
;;; Other specialized vectors
(deftest map-into.specialized-vector.1
(do-special-integer-vectors
(v #(1 2 3 4) nil)
(let ((result (list nil nil nil nil)))
(assert (eq (map-into result #'identity v) result))
(assert (equal result '(1 2 3 4)))))
nil)
(deftest map-into.specialized-vector.2
(do-special-integer-vectors
(v #(1 2 3) nil)
(let ((result (list nil nil nil nil)))
(assert (eq (map-into result #'identity v) result))
(assert (equal result '(1 2 3 nil)))))
nil)
(deftest map-into.specialized-vector.3
(do-special-integer-vectors
(v #(1 1 0 1 1) nil)
(let ((result (list nil nil nil nil)))
(assert (eq (map-into result #'identity v) result))
(assert (equal result '(1 1 0 1)))))
nil)
(deftest map-into.specialized-vector.4
(do-special-integer-vectors
(v #(1 2 1 2 2) nil)
(let ((v2 #(2 1 2 2 1)))
(assert (eq (map-into v #'identity v2) v))
(assert (equalp v #(2 1 2 2 1)))))
nil)
(deftest map-into.specialized-vector.5
(let ((len 10))
(loop for etype in '(short-float single-float double-float long-float)
for vals = (loop for i below len collect (coerce i etype))
for vec = (make-array len :initial-contents vals :element-type etype)
for target = (loop repeat len collect nil)
for result = (map-into target #'identity vec)
unless (and (eq target result)
(= (length result) len)
(= (length vec) len)
(equal vals result))
collect (list etype vals vec result)))
nil)
(deftest map-into.specialized-vector.6
(let ((len 10))
(loop for cetype in '(short-float single-float double-float long-float)
for etype = `(complex ,cetype)
for vals = (loop for i from 1 to len collect (complex (coerce i cetype)
(coerce (- i) cetype)))
for vec = (make-array len :initial-contents vals :element-type etype)
for target = (loop repeat len collect nil)
for result = (map-into target #'identity vec)
unless (and (eq target result)
(= (length result) len)
(= (length vec) len)
(equal vals result))
collect (list etype vals vec result)))
nil)
(deftest map-into.specialized-vector.7
(let ((len 10))
(loop for etype in '(short-float single-float double-float long-float)
for vals = (loop for i below len collect (coerce i etype))
for target = (make-array len :initial-contents vals :element-type etype)
for result = (map-into target #'identity vals)
unless (and (eq target result)
(= (length result) len)
(every #'= result vals))
collect (list etype vals result)))
nil)
(deftest map-into.specialized-vector.8
(let ((len 10))
(loop for cetype in '(short-float single-float double-float long-float)
for etype = `(complex ,cetype)
for vals = (loop for i from 1 to len collect (complex (coerce i cetype)
(coerce (- i) cetype)))
for target = (make-array len :initial-contents vals :element-type etype)
for result = (map-into target #'identity vals)
unless (and (eq target result)
(= (length result) len)
(every #'= result vals))
collect (list etype vals result)))
nil)
;;; Error cases
......
......@@ -269,6 +269,73 @@
;;; FIXME: Add tests for building strings of other character types
;;; Special vector types
(deftest map.specialized-vector.1
(do-special-integer-vectors
(v #(0 1 1 0 0 1) nil)
(assert (equal (map 'list #'list v v) '((0 0) (1 1) (1 1) (0 0) (0 0) (1 1)))))
nil)
(deftest map.specialized-vector.2
(do-special-integer-vectors
(v #(1 2 3 4 5 6 7) nil)
(assert (equal (map 'list #'identity v) '(1 2 3 4 5 6 7))))
nil)
(deftest map.specialized-vector.3
(do-special-integer-vectors
(v #(-1 -2 -3 -4 -5 -6 -7) nil)
(assert (equal (map 'list #'- v) '(1 2 3 4 5 6 7))))
nil)
(deftest map.specialized-vector.4
(loop for i from 1 to 40
for type = `(unsigned-byte ,i)
for bound = (ash 1 i)
for len = 10
for vals = (loop repeat len collect (random i))
for result = (map `(vector ,type) #'identity vals)
unless (and (= (length result) len)
(every #'eql vals result))
collect (list i vals result))
nil)
(deftest map.specialized-vector.5
(loop for i from 1 to 40
for type = `(signed-byte ,i)
for bound = (ash 1 i)
for len = 10
for vals = (loop repeat len collect (- (random i) (/ bound 2)))
for result = (map `(vector ,type) #'identity vals)
unless (and (= (length result) len)
(every #'eql vals result))
collect (list i vals result))
nil)
(deftest map.specialized-vector.6
(loop for type in '(short-float single-float long-float double-float)
for len = 10
for vals = (loop for i from 1 to len collect (coerce i type))
for result = (map `(vector ,type) #'identity vals)
unless (and (= (length result) len)
(every #'eql vals result))
collect (list i vals result))
nil)
(deftest map.specialized-vector.7
(loop for etype in '(short-float single-float long-float double-float
integer rational)
for type = `(complex ,etype)
for len = 10
for vals = (loop for i from 1 to len collect (complex (coerce i etype)
(coerce (- i) etype)))
for result = (map `(vector ,type) #'identity vals)
unless (and (= (length result) len)
(every #'eql vals result))
collect (list i vals result))
nil)
;;; Order of evaluation tests
(deftest map.order.1
......
......@@ -165,6 +165,60 @@
(reduce #'+ a :end 3))
6)
;;; Specialized vectors
(deftest reduce-array.20
(do-special-integer-vectors
(v #(1 0 0 1 1 0) nil)
(assert (eql (reduce #'+ v) 3)))
nil)
(deftest reduce-array.21
(do-special-integer-vectors
(v #(1 0 0 1 1 0) nil)
(assert (equal (reduce #'cons v :from-end t :initial-value nil)
'(1 0 0 1 1 0))))
nil)
(deftest reduce-array.22
(do-special-integer-vectors
(v #(1 2 3 4 5 6 7) nil)
(assert (eql (reduce #'+ v) 28))
(assert (eql (reduce #'+ v :from-end t) 28))
(assert (eql (reduce #'+ v :start 1) 27))
(assert (eql (reduce #'+ v :initial-value 10) 38))
(assert (eql (reduce #'+ v :end 6) 21)))
nil)
(deftest reduce-array.23
(let* ((len 10)
(expected (* 1/2 (1+ len) len)))
(loop for etype in '(short-float single-float double-float long-float)
for vals = (loop for i from 1 to len collect (coerce i etype))
for vec = (make-array len :initial-contents vals :element-type etype)
for result = (reduce #'+ vec)
unless (= result (coerce expected etype))
collect (list etype vals vec result)))
nil)
(deftest reduce-array.24
(let* ((len 10)
(expected (* 1/2 (1+ len) len)))
(loop for cetype in '(short-float single-float double-float long-float)
for etype = `(complex ,cetype)
for vals = (loop for i from 1 to len collect (complex (coerce i cetype)
(coerce (- i) cetype)))
for vec = (make-array len :initial-contents vals :element-type etype)
for result = (reduce #'+ vec)
unless (= result (complex (coerce expected cetype) (coerce (- expected) cetype)))
collect (list etype vals vec result)))
nil)
(deftest reduce-array.25
(do-special-integer-vectors
(v (vector 0 most-positive-fixnum 0 most-positive-fixnum 0) nil)
(assert (eql (reduce #'+ v) (* 2 most-positive-fixnum))))
nil)
;;;;;;;;
......
......@@ -179,6 +179,50 @@
(assert (string= s2 (subseq s0 i j)))))))
nil)
;;; Other specialized vectors
(deftest subseq.specialized-vector.1
(let* ((v0 #(1 0 1 1 0 1 1 0))
(len (length v0)))
(do-special-integer-vectors
(v (copy-seq v0) nil)
(loop for i from 0 below len
for v1 = (subseq v i)
do (assert (typep v1 'simple-array))
do (assert (equalp (subseq v i) (subseq v0 i)))
do (loop for j from i to len
for v2 = (subseq v i j)
do (assert (typep v2 'simple-array))
(assert (equalp v2 (subseq v0 i j)))))))
nil)
(deftest subseq.specialized-vector.2
(loop for type in '(short-float single-float long-float double-float)
for len = 10
for vals = (loop for i from 1 to len collect (coerce i type))
for vec = (make-array len :element-type type :initial-contents vals)
for result = (subseq vec 1 9)
unless (and (= (length result) 8)
(equal (array-element-type vec) (array-element-type result))
(equalp result (apply #'vector (subseq vals 1 9))))
collect (list type vals result))
nil)
(deftest subseq.specialized-vector.3
(loop for etype in '(short-float single-float long-float double-float
integer rational)
for type = `(complex ,etype)
for len = 10
for vals = (loop for i from 1 to len collect (complex (coerce i etype)
(coerce (- i) etype)))
for vec = (make-array len :element-type type :initial-contents vals)
for result = (subseq vec 1 9)
unless (and (= (length result) 8)
(equal (array-element-type vec) (array-element-type result))
(equalp result (apply #'vector (subseq vals 1 9))))
collect (list type vals result))
nil)
;;; Tests on bit vectors
(deftest subseq-bit-vector.1
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment