Commit fe4437a2 authored by pfdietz's avatar pfdietz
Browse files

Added more typep ... [simple-]array test conditions. Some are commented out...

Added more typep ... [simple-]array test conditions.  Some are commented out because gcl is failing on them right now (the rank designator bug).
parent 9ae7c196
......@@ -30,7 +30,8 @@
"Call MAKE-ARRAY and do sanity tests on the output."
(declare (ignore element-type-p initial-contents initial-contents-p
initial-element initial-element-p dio-p))
(let ((a (check-values (apply #'make-array dimensions options))))
(let ((a (check-values (apply #'make-array dimensions options)))
(rank (length dimensions-list)))
((not (typep a 'array))
......@@ -47,7 +48,7 @@
((not (typep a `(array ,element-type ,(length dimensions-list))))
((not (typep a `(array ,element-type ,rank)))
((not (typep a `(array ,element-type ,dimensions-list)))
......@@ -57,6 +58,15 @@
((loop for i from 0 below (min 10 rank)
(let ((x (append (subseq dimensions-list 0 i)
(list '*)
(subseq dimensions-list (1+ i)))))
(or (not (typep a `(array * ,x)))
(not (typep a `(array ,element-type ,x))))))
((not (check-values (arrayp a))) :fail-not-arrayp)
((and ;; (eq t element-type)
......@@ -78,7 +88,7 @@
((not (typep a `(simple-array ,element-type
,(length dimensions-list))))
((not (typep a `(simple-array ,element-type ,dimensions-list)))
......@@ -89,7 +99,7 @@
;; If the array is a vector, check that...
((and (eq (length dimensions-list) 1)
((and (eql rank 1)
;; It's in type vector
((not (typep a 'vector))
......@@ -123,7 +133,7 @@
;; The rank of the array must equal the number of dimensions
((not (equal (array-rank a) (length dimensions-list)))
((not (equal (array-rank a) rank))
;; Arrays other than vectors cannot have fill pointers
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