Commit f469d2e5 authored by pfdietz's avatar pfdietz

Added tests for various specialized vectors (specialized array element

types, fill pointers, adjustable, displaced.)
parent e44b5dcc
......@@ -143,6 +143,120 @@
(every #'alpha-char-p v)))
t #\0 nil)
;;; Displaced vectors
(deftest every.23
(let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1)))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2)))
(values
(every #'evenp v1)
(notnot (every 'evenp v2))))
nil t)
(deftest every.24
(loop for i from 1 to 40
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 (every 'evenp v1))
(every #'evenp v2)))
collect i)
nil)
(deftest every.25
(loop for i from 1 to 40
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 (every 'evenp v1))
(every #'evenp v2)))
collect i)
nil)
(deftest every.26
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'character
:displaced-to s1
:displaced-index-offset i)
collect (notnot (every 'alpha-char-p s2))))
(nil nil t t nil nil nil))
(deftest every.27
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'base-char)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'base-char
:displaced-to s1
:displaced-index-offset i)
collect (notnot (every 'alpha-char-p s2))))
(nil nil t t nil nil nil))
;;; adjustable vectors
(deftest every.28
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:adjustable t)))
(values
(notnot (every #'plusp v))
(progn
(adjust-array v '(11) :initial-element -1)
(every #'plusp v))))
t nil)
(deftest every.29
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:fill-pointer 10
:adjustable t)))
(values
(notnot (every #'plusp v))
(progn
(adjust-array v '(11) :initial-element -1)
(every #'plusp v))))
t t)
;;; Float, complex vectors
(deftest every.30
(loop for type in '(short-float single-float double-float long-float)
for v = (make-array '(6)
:element-type type
:initial-contents
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6)))
unless (every #'plusp v)
collect (list type v))
nil)
(deftest every.31
(loop for type in '(short-float single-float double-float long-float)
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)))
unless (every #'plusp v)
collect (list type v))
nil)
(deftest every.32
(loop for type in '(short-float single-float double-float long-float)
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 (every #'complexp v)
collect (list type v))
nil)
;;; Order of arguments
(deftest every.order.1
......@@ -216,3 +330,6 @@
(signals-error (every #'car '(a b c)) type-error)
t)
(deftest every.error.14
(signals-error (every #'identity '(1 2 3 . 4)) type-error)
t)
......@@ -79,6 +79,183 @@
(notany 'null '(1 2 3 nil 5))
nil)
;;; Other specialized sequences
(deftest notany.17
(let ((v (make-array '(10) :initial-contents '(0 0 0 0 1 2 3 4 5 6)
:fill-pointer 4)))
(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))
(deftest notany.18
(loop for i from 1 to 40
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)
nil)
(deftest notany.19
(loop for i from 1 to 40
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)
nil)
(deftest notany.20
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'character
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notany #'digit-char-p v))))
(nil nil nil nil nil t t t t t))
(deftest notany.21
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'base-char
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notany #'digit-char-p v))))
(nil nil nil nil nil t t t t t))
(deftest notany.22
(let ((v (make-array '(5) :initial-contents "abcde"
:element-type 'base-char)))
(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)
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))
nil)
(deftest notany.24
(loop for type in '(short-float single-float double-float long-float)
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))
nil)
(deftest notany.25
(loop for type in '(short-float single-float double-float long-float)
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))
nil)
;;; Displaced vectors
(deftest notany.26
(let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1)))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2)))
(values
(notany #'oddp v1)
(notnot (notany #'oddp v2))))
nil t)
(deftest notany.27
(loop for i from 1 to 40
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)
nil)
(deftest notany.28
(loop for i from 1 to 40
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)
nil)
(deftest notany.29
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'character
:displaced-to s1
:displaced-index-offset i)
collect (not (notany 'digit-char-p s2))))
(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
for s2 = (make-array '(2) :element-type 'base-char
:displaced-to s1
:displaced-index-offset i)
collect (not (notany 'digit-char-p s2))))
(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)
:adjustable t)))
(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)
:fill-pointer 10
:adjustable t)))
(values
(notnot (notany #'minusp v))
(progn
(adjust-array v '(11) :initial-element -1)
(notnot (notany #'minusp v)))))
t t)
(deftest notany.order.1
(let ((i 0) a b)
(values
......
......@@ -79,6 +79,186 @@
(notevery 'null '(nil nil nil nil))
nil)
;;; Other specialized sequences
(deftest notevery.17
(let ((v (make-array '(10) :initial-contents '(0 0 0 0 1 2 3 4 5 6)
:fill-pointer 4)))
(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))
(deftest notevery.18
(loop for i from 1 to 40
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)
nil)
(deftest notevery.19
(loop for i from 1 to 40
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)
nil)
(deftest notevery.20
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'character
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notevery #'alpha-char-p v))))
(t t t t t nil nil nil nil nil))
(deftest notevery.21
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'base-char
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notevery #'alpha-char-p v))))
(t t t t t nil nil nil nil nil))
(deftest notevery.22
(let ((v (make-array '(5) :initial-contents "abcde"
:element-type 'base-char)))
(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)))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2)))
(values
(not (notevery #'evenp v1))
(not (notevery 'evenp v2))))
nil t)
(deftest notevery.24
(loop for i from 1 to 40
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)
nil)
(deftest notevery.25
(loop for i from 1 to 40
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)
nil)
(deftest notevery.26
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'character
:displaced-to s1
:displaced-index-offset i)
collect (not (notevery 'alpha-char-p s2))))
(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
for s2 = (make-array '(2) :element-type 'base-char
:displaced-to s1
:displaced-index-offset i)
collect (not (notevery 'alpha-char-p s2))))
(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)
:adjustable t)))
(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)
:fill-pointer 10
:adjustable t)))
(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)
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))
nil)
(deftest notevery.31
(loop for type in '(short-float single-float double-float long-float)
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))
nil)
(deftest notevery.32
(loop for type in '(short-float single-float double-float long-float)
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))
nil)
(deftest notevery.order.1
(let ((i 0) a b)
(values
......
......@@ -78,6 +78,182 @@
(not-mv (some 'null '(1 2 3 nil 5)))
nil)
;;; Other specialized sequences
(deftest some.17
(let ((v (make-array '(10) :initial-contents '(0 0 0 0 1 2 3 4 5 6)
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (notnot (some #'plusp v))))
(nil nil nil nil nil t t t t t))
(deftest some.18
(loop for i from 1 to 40
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 (notnot (some #'plusp v)))
'(nil nil nil nil nil t t t t t)))
collect i)
nil)
(deftest some.19
(loop for i from 1 to 40
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 (notnot (some #'minusp v)))
'(nil nil nil nil nil t t t t t)))
collect i)
nil)
(deftest some.20
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'character
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (notnot (some #'digit-char-p v))))
(nil nil nil nil nil t t t t t))
(deftest some.21
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'base-char
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (notnot (some #'digit-char-p v))))
(nil nil nil nil nil t t t t t))
(deftest some.22
(let ((v (make-array '(5) :initial-contents "abcde"
:element-type 'base-char)))
(values
(some #'digit-char-p v)
(setf (aref v 2) #\0)
(notnot (some #'digit-char-p v))))
nil #\0 t)
(deftest some.23
(loop for type in '(short-float single-float double-float long-float)
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)))
unless (some #'zerop v)
collect (list type v))
nil)
(deftest some.24
(loop for type in '(short-float single-float double-float long-float)
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)))
when (some #'zerop v)
collect (list type v))
nil)
(deftest some.25
(loop for type in '(short-float single-float double-float long-float)
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 (some (complement #'complexp) v)
collect (list type v))
nil)
;;; Displaced vectors
(deftest some.26
(let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1)))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2)))
(values
(notnot (some #'oddp v1))
(some #'oddp v2)))
t nil)
(deftest some.27
(loop for i from 1 to 40
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 (some 'oddp v1))
(not (some #'oddp v2)))
collect i)
nil)
(deftest some.28
(loop for i from 1 to 40
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 (some 'oddp v1)
(not (some #'oddp v2))))
collect i)
nil)
(deftest some.29
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'character
:displaced-to s1
:displaced-index-offset i)
collect (notnot (some 'digit-char-p s2))))
(t t nil nil t t t))
(deftest some.30
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'base-char)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'base-char
:displaced-to s1
:displaced-index-offset i)
collect (notnot (some 'digit-char-p s2))))
(t t nil nil t t t))
(deftest some.31
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:adjustable t)))
(values
(some #'minusp v)
(progn
(adjust-array v '(11) :initial-element -1)
(notnot (some #'minusp v)))))
nil t)
(deftest some.32
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:fill-pointer 10
:adjustable t)))
(values
(some #'minusp v)
(progn
(adjust-array v '(11) :initial-element -1)
(some #'minusp v))))
nil nil)
(deftest some.order.1
(let ((i 0) x y)
(values
......@@ -148,4 +324,7 @@
(signals-error (some #'cons '(a b c) '(b c d) '(c d e)) program-error)