diff --git a/ansi-tests/adjustable-array-p.lsp b/ansi-tests/adjustable-array-p.lsp
new file mode 100644
index 0000000000000000000000000000000000000000..e5873a3c764755908e0735083ed2b838a1dc5f04
--- /dev/null
+++ b/ansi-tests/adjustable-array-p.lsp
@@ -0,0 +1,47 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Mon Jan 20 21:25:22 2003
+;;;; Contains: Tests for ADJUSTABLE-ARRAY-P
+
+(in-package :cl-test)
+
+(deftest adjustable-array-p.1
+  (notnot (adjustable-array-p (make-array '(5) :adjustable t)))
+  t)
+
+(deftest adjustable-array-p.2
+  (notnot (adjustable-array-p (make-array nil :adjustable t)))
+  t)
+
+(deftest adjustable-array-p.3
+  (notnot (adjustable-array-p (make-array '(2 3) :adjustable t)))
+  t)
+
+(deftest adjustable-array-p.4
+  (notnot (adjustable-array-p (make-array '(2 2 2) :adjustable t)))
+  t)
+
+(deftest adjustable-array-p.5
+  (notnot (adjustable-array-p (make-array '(2 2 2 2) :adjustable t)))
+  t)
+
+;;; Error tests
+
+(deftest adjustable-array-p.error.1
+  (classify-error (adjustable-array-p))
+  program-error)
+
+(deftest adjustable-array-p.error.2
+  (classify-error (adjustable-array-p "aaa" nil))
+  program-error)
+
+(deftest adjustable-array-p.error.3
+  (classify-error (adjustable-array-p 10))
+  type-error)
+
+(deftest adjustable-array-p.error.4
+  (loop for e in *mini-universe*
+	unless (or (typep e 'array)
+		   (eq 'type-error (classify-error** `(adjustable-array-p ',e))))
+	collect e)
+  nil)
diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp
index f3df359b488406b2d8f7ef12b1ad54c797492a51..ae47be70e98a9fa7d16ed6f58306cc80da50fc52 100644
--- a/ansi-tests/ansi-aux.lsp
+++ b/ansi-tests/ansi-aux.lsp
@@ -144,6 +144,11 @@ the condition to go uncaught if it cannot be classified."
      (package-error () 'package-error)
      (type-error    () 'type-error)
      (control-error () 'control-error)
+     (stream-error  () 'stream-error)
+     (reader-error  () 'reader-error)
+     (file-error    () 'file-error)
+     (control-error () 'control-error)
+     (cell-error    () 'cell-error)
   )))
 
 (defun classify-error** (form)
diff --git a/ansi-tests/array-aux.lsp b/ansi-tests/array-aux.lsp
new file mode 100644
index 0000000000000000000000000000000000000000..8db9839ae99b49655a9c09fa6b941f45e7284bf8
--- /dev/null
+++ b/ansi-tests/array-aux.lsp
@@ -0,0 +1,126 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Tue Jan 21 05:11:31 2003
+;;;; Contains: Auxiliary functions for array tests
+
+(in-package :cl-test)
+
+(defun make-array-check-upgrading (type)
+  (subtypep* type (array-element-type (make-array 0 :element-type type))))
+
+(defun subtypep-or-unknown (subtype supertype)
+  (multiple-value-bind (is-subtype is-known)
+      (subtypep subtype supertype)
+    (or (not is-known) (notnot is-subtype))))
+
+(defun make-array-with-checks (dimensions
+			       &rest options
+			       &key
+			       (element-type t element-type-p)
+			       (initial-contents nil initial-contents-p)
+			       (initial-element nil initial-element-p)
+			       (adjustable nil)
+			       (fill-pointer nil)
+			       (displaced-to nil)
+			       (displaced-index-offset 0 dio-p)
+			       &aux
+			       (dimensions-list (if (listp dimensions)
+						    dimensions
+						  (list dimensions))))
+  "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))
+  (let ((a (apply #'make-array dimensions options)))
+    (cond
+     ((not (typep a 'array)) :fail-not-array)
+
+     ((and (eq t element-type)
+	   (not adjustable)
+	   (not fill-pointer)
+	   (not displaced-to)
+	   (not (typep a 'simple-array)))
+      :fail-not-simple-array)
+
+     ;; If the array is a vector, check that...
+     ((and (eq (length dimensions-list) 1) 
+	   (cond
+	    ;; It's in type vector
+	    ((not (typep a 'vector))
+	     :fail-not-vector)
+	    ;; If the element type is a subtype of BIT, then it's a
+	    ;; bit vector...
+	    ((and (subtypep 'bit element-type)
+		  (subtypep element-type 'bit)
+		  (or (not (bit-vector-p a))
+		      (not (typep a 'bit-vector))))
+	     :fail-not-bit-vector)
+	    ;; If not adjustable, fill pointered, or displaced,
+	    ;; then it's a simple vector or simple bit vector
+	    ;; (if the element-type is appropriate)
+	    ((and (not adjustable)
+		  (not fill-pointer)
+		  (not displaced-to)
+		  (cond
+		   ((and (eq t element-type)
+			 (or (not (simple-vector-p a))
+			     (not (typep a 'simple-vector))))
+		    :fail-not-simple-vector)
+		   ((and (subtypep 'bit element-type)
+			 (subtypep element-type 'bit)
+			 (or (not (simple-bit-vector-p a))
+			     (not (typep a 'simple-bit-vector))))
+		    :fail-not-simple-bit-vector) ))) )))
+
+     ;; The dimensions of the array must be initialized properly
+     ((not (equal (array-dimensions a) dimensions-list))
+      :fail-array-dimensions)
+
+     ;; The rank of the array must equal the number of dimensions
+     ((not (equal (array-rank a) (length dimensions-list)))
+      :fail-array-rank)
+
+     ;; Arrays other than vectors cannot have fill pointers
+     ((and (not (equal (array-rank a) 1))
+	   (array-has-fill-pointer-p a))
+      :fail-non-vector-fill-pointer)
+
+     ;; The actual element type must be a supertype of the element-type
+     ;; argument
+     ((not (subtypep-or-unknown element-type (array-element-type a)))
+      :failed-array-element-type)
+
+     ;; If :adjustable is given, the array must be adjustable.
+     ((and adjustable
+	   (not (adjustable-array-p a))
+	   :fail-adjustable))
+
+     ;; If :fill-pointer is given, the array must have a fill pointer
+     ((and fill-pointer
+	   (not (array-has-fill-pointer-p a))
+	   :fail-has-fill-pointer))
+
+     ;; If the fill pointer is given as an integer, it must be the value
+     ;; of the fill pointer of the new array
+     ((and (integerp fill-pointer)
+	   (not (eql fill-pointer (fill-pointer a)))
+	   :fail-fill-pointer-1))
+
+     ;; If the fill-pointer argument is t, the fill pointer must be
+     ;; set to the vector size.
+     ((and (eq fill-pointer t)
+	   (not (eql (first dimensions-list) (fill-pointer a)))
+	   :fail-fill-pointer-2))
+
+     ;; If displaced-to another array, check that this is proper
+     ((and
+       displaced-to
+       (multiple-value-bind (actual-dt actual-dio)
+	   (array-displacement a)
+	 (cond
+	  ((not (eq actual-dt displaced-to))
+	   :fail-displacement-1)
+	  ((not (eql actual-dio displaced-index-offset))
+	   :fail-displaced-index-offset)))))
+
+     ;; No problems -- return the array
+     (t a))))
\ No newline at end of file
diff --git a/ansi-tests/array-dimension.lsp b/ansi-tests/array-dimension.lsp
new file mode 100644
index 0000000000000000000000000000000000000000..8831372a00e729ed3e03b535917b468b655fbe9c
--- /dev/null
+++ b/ansi-tests/array-dimension.lsp
@@ -0,0 +1,55 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Tue Jan 21 06:55:14 2003
+;;;; Contains: Tests of ARRAY-DIMENSION
+
+(in-package :cl-test)
+
+;;; array-dimension is also tested by the tests in make-array.lsp
+
+(deftest array-dimension.1
+  (array-dimension #(0 1 2 3) 0)
+  4)
+
+(deftest array-dimension.2
+  (array-dimension "abcdef" 0)
+  6)
+
+(deftest array-dimension.3
+  (array-dimension #2a((1 2 3 4)(5 6 7 8)) 0)
+  2)
+
+(deftest array-dimension.4
+  (array-dimension #2a((1 2 3 4)(5 6 7 8)) 1)
+  4)
+
+(deftest array-dimension.5
+  (let ((a (make-array '(10) :fill-pointer 5)))
+    (array-dimension a 0))
+  10)
+
+(deftest array-dimension.6
+  (let ((a (make-array '(10) :adjustable t)))
+    (values
+     (array-dimension a 0)
+     (progn
+       (adjust-array a '(20))
+       (array-dimension a 0))))
+  10 20)
+
+;;; Error tests
+
+(deftest array-dimension.error.1
+  (classify-error (array-dimension))
+  program-error)
+
+(deftest array-dimension.error.2
+  (classify-error (array-dimension #(a b c)))
+  program-error)
+
+(deftest array-dimension.error.3
+  (classify-error (array-dimension #(a b c) 0 nil))
+  program-error)
+
+
+
diff --git a/ansi-tests/array-dimensions.lsp b/ansi-tests/array-dimensions.lsp
new file mode 100644
index 0000000000000000000000000000000000000000..9ae1d8746bd5c023af9d1dd97dd4846e87c0a585
--- /dev/null
+++ b/ansi-tests/array-dimensions.lsp
@@ -0,0 +1,58 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Tue Jan 21 06:59:37 2003
+;;;; Contains: Tests of ARRAY-DIMENSIONS
+
+(in-package :cl-test)
+
+;;; The tests in make-array.lsp also test this function
+
+(deftest array-dimensions.1
+  (array-dimensions #0aX)
+  nil)
+
+(deftest array-dimensions.2
+  (array-dimensions #(a b c d))
+  (4))
+
+(deftest array-dimensions.3
+  (array-dimensions #*0011011011)
+  (10))
+
+(deftest array-dimensions.4
+  (array-dimensions "abcdef")
+  (6))
+
+(deftest array-dimensions.5
+  (array-dimensions #2a((1 2 3)(4 5 6)(7 8 9)(10 11 12)))
+  (4 3))
+
+(deftest array-dimensions.6
+  (let ((a (make-array '(2 3 4) :adjustable t)))
+    (values (array-dimension a 0)
+	    (array-dimension a 1)
+	    (array-dimension a 2)))
+  2 3 4)
+
+(deftest array-dimensions.7
+  (let ((a (make-array '(10) :fill-pointer 5)))
+    (array-dimension a 0))
+  10)
+
+;;; Error tests
+
+(deftest array-dimensions.error.1
+  (classify-error (array-dimensions))
+  program-error)
+
+(deftest array-dimensions.error.2
+  (classify-error (array-dimensions #(a b c) nil))
+  program-error)
+
+(deftest array-dimension.error.3
+  (loop for e in *mini-universe*
+	unless (or (typep e 'array)
+		   (eq 'type-error
+		       (classify-error** `(array-dimensions ',e))))
+	collect e)
+  nil)
diff --git a/ansi-tests/array-displacement.lsp b/ansi-tests/array-displacement.lsp
new file mode 100644
index 0000000000000000000000000000000000000000..fb08b331908650c410197fe555cabf2edc0bc403
--- /dev/null
+++ b/ansi-tests/array-displacement.lsp
@@ -0,0 +1,113 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Tue Jan 21 06:20:51 2003
+;;;; Contains: Tests for ARRAY-DISPLACEMENT
+
+(in-package :cl-test)
+
+;;; The tests in make-array.lsp also test array-displacement
+
+;;; The standard is contradictory about whether arrays created with
+;;; :displaced-to NIL should return NIL as their primary value or
+;;; not.  I will assume (as per Kent Pitman's comment on comp.lang.lisp)
+;;; that an implementation is free to implement all arrays as actually
+;;; displaced.  Therefore, I've omitted all the tests of not-expressly
+;;; displaced arrays.
+
+;;; Behavior on expressly displaced arrays
+
+(deftest array-displacement.7
+  (let* ((a (make-array '(10)))
+	 (b (make-array '(10) :displaced-to a)))
+    (multiple-value-bind (dt disp)
+	(array-displacement b)
+      (and (eqt a dt)
+	   (eqlt disp 0))))
+  t)
+
+(deftest array-displacement.8
+  (let* ((a (make-array '(10)))
+	 (b (make-array '(5) :displaced-to a :displaced-index-offset 2)))
+    (multiple-value-bind (dt disp)
+	(array-displacement b)
+      (and (eqt a dt)
+	   (eqlt disp 2))))
+  t)
+
+(deftest array-displacement.9
+  (let* ((a (make-array '(10) :element-type 'base-char))
+	 (b (make-array '(5) :displaced-to a :displaced-index-offset 2
+			:element-type 'base-char)))
+    (multiple-value-bind (dt disp)
+	(array-displacement b)
+      (and (eqt a dt)
+	   (eqlt disp 2))))
+  t)
+
+(deftest array-displacement.10
+  (let* ((a (make-array '(10) :element-type 'base-char))
+	 (b (make-array '(5) :displaced-to a
+			:element-type 'base-char)))
+    (multiple-value-bind (dt disp)
+	(array-displacement b)
+      (and (eqt a dt)
+	   (eqlt disp 0))))
+  t)
+
+(deftest array-displacement.11
+  (let* ((a (make-array '(10) :element-type 'bit))
+	 (b (make-array '(5) :displaced-to a :displaced-index-offset 2
+			:element-type 'bit)))
+    (multiple-value-bind (dt disp)
+	(array-displacement b)
+      (and (eqt a dt)
+	   (eqlt disp 2))))
+  t)
+
+(deftest array-displacement.12
+  (let* ((a (make-array '(10) :element-type 'bit))
+	 (b (make-array '(5) :displaced-to a
+			:element-type 'bit)))
+    (multiple-value-bind (dt disp)
+	(array-displacement b)
+      (and (eqt a dt)
+	   (eqlt disp 0))))
+  t)
+
+(deftest array-displacement.13
+  (let* ((a (make-array '(10) :element-type '(integer 0 255)))
+	 (b (make-array '(5) :displaced-to a :displaced-index-offset 2
+			:element-type '(integer 0 255))))
+    (multiple-value-bind (dt disp)
+	(array-displacement b)
+      (and (eqt a dt)
+	   (eqlt disp 2))))
+  t)
+
+(deftest array-displacement.14
+  (let* ((a (make-array '(10) :element-type '(integer 0 255)))
+	 (b (make-array '(5) :displaced-to a
+			:element-type '(integer 0 255))))
+    (multiple-value-bind (dt disp)
+	(array-displacement b)
+      (and (eqt a dt)
+	   (eqlt disp 0))))
+  t)
+
+;;; Error tests
+
+(deftest array-displacement.error.1
+  (classify-error (array-displacement))
+  program-error)
+
+(deftest array-displacement.error.2
+  (classify-error (array-displacement #(a b c) nil))
+  program-error)
+
+(deftest array-displacement.error.3
+  (loop for e in *mini-universe*
+	unless (or (typep e 'array)
+		   (eq 'type-error
+		       (classify-error** `(array-displacement ',e))))
+	collect e)
+  nil)
diff --git a/ansi-tests/array-in-bounds-p.lsp b/ansi-tests/array-in-bounds-p.lsp
new file mode 100644
index 0000000000000000000000000000000000000000..51e9a156052752d0306a8ba2d688a73124049d76
--- /dev/null
+++ b/ansi-tests/array-in-bounds-p.lsp
@@ -0,0 +1,140 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Tue Jan 21 19:57:29 2003
+;;;; Contains: Tests for ARRAY-IN-BOUNDS-P
+
+(in-package :cl-test)
+
+(deftest array-in-bounds-p.1
+  (array-in-bounds-p #() 0)
+  nil)
+
+(deftest array-in-bounds-p.2
+  (array-in-bounds-p #() -1)
+  nil)
+
+(deftest array-in-bounds-p.3
+  (let ((a #(a b c d)))
+    (loop for i from 0 to 4 collect (notnot (array-in-bounds-p a i))))
+  (t t t t nil))
+
+(deftest array-in-bounds-p.4
+  (notnot (array-in-bounds-p #0aNIL))
+  t)
+
+(deftest array-in-bounds-p.5
+  (array-in-bounds-p "" 0)
+  nil)
+
+(deftest array-in-bounds-p.6
+  (array-in-bounds-p "" -1)
+  nil)
+
+(deftest array-in-bounds-p.7
+  (let ((a "abcd"))
+    (loop for i from 0 to 4 collect (notnot (array-in-bounds-p a i))))
+  (t t t t nil))
+
+(deftest array-in-bounds-p.8
+  (array-in-bounds-p #* 0)
+  nil)
+
+(deftest array-in-bounds-p.9
+  (array-in-bounds-p #* -1)
+  nil)
+
+(deftest array-in-bounds-p.10
+  (let ((a #*0110))
+    (loop for i from 0 to 4 collect (notnot (array-in-bounds-p a i))))
+  (t t t t nil))
+
+;; Fill pointer tests
+
+(deftest array-in-bounds-p.11
+  (let ((a (make-array '(10) :fill-pointer 5)))
+    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i))))
+  (nil t t t t t t t t t t nil))
+
+(deftest array-in-bounds-p.12
+  (let ((a (make-array '(10) :fill-pointer 5 :element-type 'bit :initial-element 0)))
+    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i))))
+  (nil t t t t t t t t t t nil))
+
+(deftest array-in-bounds-p.13
+  (let ((a (make-array '(10) :fill-pointer 5 :element-type 'base-char :initial-element #\x)))
+    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i))))
+  (nil t t t t t t t t t t nil))
+
+(deftest array-in-bounds-p.14
+  (let ((a (make-array '(10) :fill-pointer 5 :element-type 'character :initial-element #\x)))
+    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i))))
+  (nil t t t t t t t t t t nil))
+
+;;; Displaced arrays
+
+(deftest array-in-bounds-p.15
+  (let* ((a1 (make-array '(20)))
+	 (a2 (make-array '(10) :displaced-to a1)))
+    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a2 i))))
+  (nil t t t t t t t t t t nil))
+
+(deftest array-in-bounds-p.16
+  (let* ((a1 (make-array '(20) :element-type 'bit :initial-element 0))
+	 (a2 (make-array '(10) :displaced-to a1 :element-type 'bit)))
+    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a2 i))))
+  (nil t t t t t t t t t t nil))
+
+(deftest array-in-bounds-p.17
+  (let* ((a1 (make-array '(20) :element-type 'character :initial-element #\x))
+	 (a2 (make-array '(10) :displaced-to a1 :element-type 'character)))
+    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a2 i))))
+  (nil t t t t t t t t t t nil))
+
+;;; Multidimensional arrays
+
+(deftest array-in-bounds-p.18
+  (let ((a (make-array '(3 4))))
+    (loop for i from -1 to 3 collect
+	  (loop for j from -1 to 4 collect
+		(notnot (array-in-bounds-p a i j)))))
+  ((nil nil nil nil nil nil)
+   (nil t   t   t   t   nil)
+   (nil t   t   t   t   nil)
+   (nil t   t   t   t   nil)
+   (nil nil nil nil nil nil)))
+
+(deftest array-in-bounds-p.19
+  (let ((a (make-array '(1 3 4) :adjustable t)))
+    (loop for i from -1 to 3 collect
+	  (loop for j from -1 to 4 collect
+		(notnot (array-in-bounds-p a 0 i j)))))
+  ((nil nil nil nil nil nil)
+   (nil t   t   t   t   nil)
+   (nil t   t   t   t   nil)
+   (nil t   t   t   t   nil)
+   (nil nil nil nil nil nil)))
+
+;;; Very large indices
+
+(deftest array-in-bounds-p.20
+  (array-in-bounds-p #(a b c) (1+ most-positive-fixnum))
+  nil)
+
+(deftest array-in-bounds-p.21
+  (array-in-bounds-p #(a b c) (1- most-negative-fixnum))
+  nil)
+
+(deftest array-in-bounds-p.22
+  (array-in-bounds-p #(a b c) 1000000000000000000)
+  nil)
+
+(deftest array-in-bounds-p.23
+  (array-in-bounds-p #(a b c) -1000000000000000000)
+  nil)
+
+;;; Error tests
+
+(deftest array-in-bounds-p.error.1
+  (classify-error (array-in-bounds-p))
+  program-error)
+
diff --git a/ansi-tests/array-rank.lsp b/ansi-tests/array-rank.lsp
new file mode 100644
index 0000000000000000000000000000000000000000..78af7b952d4271f2be6ff2c016950daded133406
--- /dev/null
+++ b/ansi-tests/array-rank.lsp
@@ -0,0 +1,37 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Tue Jan 21 20:32:57 2003
+;;;; Contains: Tests for ARRAY-RANK
+
+(in-package :cl-test)
+
+;;; Most tests for ARRAY-RANK are in make-array.lsp
+
+(deftest array-rank.1
+  (array-rank #0aNIL)
+  0)
+
+(deftest array-rank.2
+  (loop for e in *universe*
+	when (and (typep e 'vector)
+		  (not (eql (array-rank e) 1)))
+	collect e)
+  nil)
+
+;;; Error tests
+
+(deftest array-rank.error.1
+  (classify-error (array-rank))
+  program-error)
+
+(deftest array-rank.error.2
+  (classify-error (array-rank #(a b c) nil))
+  program-error)
+
+(deftest array-rank.error.3
+  (loop for e in *mini-universe*
+	when (and (not (typep e 'array))
+		  (not (eq (classify-error** `(array-rank ',e))
+			   'type-error)))
+	collect e)
+  nil)
diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp
index 8291c42b19acd8bdc1813a732ee28181d92b07ca..811ac99b23b6e763d33a5db9a1a124f2e89d3bb5 100644
--- a/ansi-tests/gclload2.lsp
+++ b/ansi-tests/gclload2.lsp
@@ -133,7 +133,15 @@
 (load "cons-test-25.lsp")
 
 ;;; Tests on arrays
+(compile-and-load "array-aux.lsp")
 (load "make-array.lsp")
+(load "adjustable-array-p.lsp")
+(load "array-displacement.lsp")
+(load "adjustable-array-p.lsp")
+(load "array-dimension.lsp")
+(load "array-dimensions.lsp")
+(load "array-in-bounds-p.lsp")
+(load "array-rank.lsp")
 
 ;;; Tests of packages
 
diff --git a/ansi-tests/make-array.lsp b/ansi-tests/make-array.lsp
index ef130bc1eddfcaa119eeb2aefe103d77b0aa0633..4c238063fd331acc17fdec0c4b0c95074dbb7ffb 100644
--- a/ansi-tests/make-array.lsp
+++ b/ansi-tests/make-array.lsp
@@ -5,77 +5,7 @@
 
 (in-package :cl-test)
 
-(defun make-array-check-upgrading (type)
-  (subtypep* type (array-element-type (make-array 0 :element-type type))))
-
-(defun make-array-with-checks (dimensions
-			       &rest options
-			       &key
-			       (element-type t element-type-p)
-			       (initial-contents nil intial-contents-p)
-			       (initial-element nil initial-element-p)
-			       (adjustable nil)
-			       (fill-pointer nil)
-			       (displaced-to nil)
-			       (displaced-index-offset 0 dio-p)
-			       &aux
-			       (dimensions-list (if (listp dimensions)
-						    dimensions
-						  (list dimensions))))
-  "Call MAKE-ARRAY and do sanity tests on the output."
-  (let ((a (apply #'make-array dimensions options)))
-    (cond
-     ((not (typep a 'array)) :fail-not-array)
-     ((and (eq t element-type)
-	   (not adjustable)
-	   (not fill-pointer)
-	   (not displaced-to)
-	   (not (typep a 'simple-array)))
-      :fail-not-simple-array)
-     ((and (eq (length dimensions-list) 1) 
-	   (cond
-	    ((not (typep a 'vector))
-	     :fail-not-vector)
-	    ((and (subtypep 'bit element-type)
-		  (subtypep element-type 'bit)
-		  (or (not (bit-vector-p a))
-		      (not (typep a 'bit-vector))))
-	     :fail-not-bit-vector)
-	    ((and (not adjustable)
-		  (not fill-pointer)
-		  (not displaced-to)
-		  (cond
-		   ((and (eq t element-type)
-			 (or (not (simple-vector-p a))
-			     (not (typep a 'simple-vector))))
-		    :fail-not-simple-vector)
-		   ((and (subtypep 'bit element-type)
-			 (subtypep element-type 'bit)
-			 (or (not (simple-bit-vector-p a))
-			     (not (typep a 'simple-bit-vector))))
-		    :fail-not-simple-bit-vector) ))) )))
-     ((not (equal (array-dimensions a) dimensions-list))
-      :fail-array-dimensions)
-     ((not (equal (array-rank a) (length dimensions-list)))
-      :fail-array-rank)
-     ((multiple-value-bind (sub good)
-	  (subtypep element-type (array-element-type a))
-	(and good
-	     (not sub)
-	     :failed-array-element-type)))
-     ((and adjustable
-	   (not (adjustable-array-p a))
-	   :fail-adjustable))
-     ((and fill-pointer
-	   (not (array-has-fill-pointer-p a))
-	   :fail-has-fill-pointer))
-     ((and (integerp fill-pointer)
-	   (not (eql fill-pointer (fill-pointer a)))
-	   :fail-fill-pointer-1))
-     ((and (eq fill-pointer t)
-	   (not (eql (first dimensions-list) (fill-pointer a)))
-	   :fail-fill-pointer-2))
-     (t a))))
+;;; See array-aux.lsp for auxiliary functions
 
 (deftest make-array.1
   (let ((a (make-array-with-checks 10)))
@@ -283,6 +213,17 @@
 	      :nonsense-argument t)
   #(x x x x))
 
+(deftest make-array.28
+  (let ((*package* (find-package :cl-test)))
+    (let ((len (1- (min 10000 array-rank-limit))))
+      (equalpt (make-array (make-list len :initial-element 1) :initial-element 'x)
+	       (read-from-string (concatenate
+				  'string
+				  (format nil "#~dA" len)
+				  (make-string len :initial-element #\()
+				  "x"
+				  (make-string len :initial-element #\)))))))
+  t)
 
 ;;; Adjustable arrays
 
@@ -561,6 +502,44 @@
 			    :adjustable t))
   #(f g h i j k l m))
 
+(deftest make-array.displaced.27
+  (let ((a (make-array '(10)
+		       :initial-contents '(1 2 3 4 5 6 7 8 9 10)
+		       :fill-pointer t)))
+    (make-array-with-checks '(2 4) :displaced-to a))
+  #2a((1 2 3 4) (5 6 7 8)))
+
+(deftest make-array.displaced.28
+  (let ((a (make-array '(10)
+		       :initial-contents '(1 2 3 4 5 6 7 8 9 10)
+		       :fill-pointer 4)))
+    (make-array-with-checks '(2 4) :displaced-to a))
+  #2a((1 2 3 4) (5 6 7 8)))
+
+(deftest make-array.displaced.29
+  (let ((a (make-array '(10) :initial-element 0)))
+    (prog1
+	(make-array-with-checks '(2 4) :displaced-to a)
+      (loop for i below 10 do (setf (aref a i) (1+ i)))))
+  #2a((1 2 3 4) (5 6 7 8)))
+
+(deftest make-array.displaced.30
+  (let* ((a1 (make-array '(10) :initial-element 0))
+	 (a2 (make-array '(10) :displaced-to a1)))
+    (prog1
+	(make-array-with-checks '(2 4) :displaced-to a2)
+      (loop for i below 10 do (setf (aref a2 i) (1+ i)))))
+  #2a((1 2 3 4) (5 6 7 8)))
+
+(deftest make-array.displaced.31
+  (let* ((a1 (make-array '(10) :initial-element 0))
+	 (a2 (make-array '(10) :displaced-to a1)))
+    (prog1
+	(make-array-with-checks '(2 4) :displaced-to a2)
+      (loop for i below 10 do (setf (aref a1 i) (1+ i)))))
+  #2a((1 2 3 4) (5 6 7 8)))
+
+
 ;;; Keywords tests
 
 (deftest make-array.allow-other-keys.1
diff --git a/ansi-tests/universe.lsp b/ansi-tests/universe.lsp
index 93eac3503941b4b37e7803d154b3eda531ca9a1f..f80e5417b13c761e72072350416031fe90815180 100644
--- a/ansi-tests/universe.lsp
+++ b/ansi-tests/universe.lsp
@@ -314,3 +314,23 @@
       *random-states*
       nil)))
 
+(defvar *mini-universe*
+  (remove-duplicates
+   (mapcar #'first
+	   (list *symbols*
+		 *numbers*
+		 *characters*
+		 (mapcar #'copy-seq *strings*)
+		 *conses*
+		 *condition-objects*
+		 *package-objects*
+		 *arrays*
+		 *hash-tables*
+		 *pathnames*
+		 *streams*
+		 *readtables*
+		 *structures*
+		 *functions*
+		 *random-states*))))
+
+