diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp
index fc86b3784ae61f8ff50fe180ff12f689abb53139..4c1478284bcec8c0464af63cae0081217d36f2f5 100644
--- a/ansi-tests/ansi-aux.lsp
+++ b/ansi-tests/ansi-aux.lsp
@@ -51,19 +51,21 @@
   (and (typep a1 'array)
        (typep a2 'array)
        (= (array-rank a1) (array-rank a2))
-       (let ((ad (array-dimensions a1)))
-	 (and (equal ad (array-dimensions a2))
-	      (if (= (array-rank a1) 1)
-		  (let ((as (first ad)))
-		    (loop
-		     for i from 0 below as
-		     always (equal (aref a1 i) (aref a2 i))))
-		(let ((as (array-total-size a1)))
-		  (and (= as (array-total-size a2))
-		       (loop
-			for i from 0 below as
-			always (equal (row-major-aref a1 i)
-				      (row-major-aref a2 i))))))))))
+       (if (= (array-rank a1) 0)
+	   (equal (aref a1) (aref a2))
+	 (let ((ad (array-dimensions a1)))
+	   (and (equal ad (array-dimensions a2))
+		(if (= (array-rank a1) 1)
+		    (let ((as (first ad)))
+		      (loop
+		       for i from 0 below as
+		       always (equal (aref a1 i) (aref a2 i))))
+		  (let ((as (array-total-size a1)))
+		    (and (= as (array-total-size a2))
+			 (loop
+			  for i from 0 below as
+			  always (equal (row-major-aref a1 i)
+					(row-major-aref a2 i)))))))))))
 
 ;;; *universe* is defined elsewhere -- it is a list of various
 ;;; lisp objects used when stimulating things in various tests.
diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp
index abd0c770c1770bdb111fb49ae1d465d7c0d0f583..4888dd66d16e9f301c6e5a79d323b9daf149b845 100644
--- a/ansi-tests/gclload2.lsp
+++ b/ansi-tests/gclload2.lsp
@@ -123,6 +123,9 @@
 (load "cons-test-24.lsp")
 (load "cons-test-25.lsp")
 
+;;; Tests on arrays
+(load "make-array.lsp")
+
 ;;; Tests of packages
 
 (load "packages.lsp")
diff --git a/ansi-tests/make-array.lsp b/ansi-tests/make-array.lsp
index b47f39cb53490a78ae6b4538559e59ea9f274a9d..974b2eab26c8b5588bf94172da9e5a4c6aa51b4e 100644
--- a/ansi-tests/make-array.lsp
+++ b/ansi-tests/make-array.lsp
@@ -8,3 +8,208 @@
 (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))))
+
+(deftest make-array.1
+  (let ((a (make-array-with-checks 10)))
+    (and (symbolp a) a))
+  nil)
+
+(deftest make-array.1a
+  (let ((a (make-array-with-checks '(10))))
+    (and (symbolp a) a))
+  nil)
+
+(deftest make-array.2
+  (make-array-with-checks 3 :initial-element 'z)
+  #(z z z))
+
+(deftest make-array.2a
+  (make-array-with-checks 3 :initial-contents '(a b c))
+  #(a b c))
+
+(deftest make-array.2b
+  (make-array-with-checks 3 :initial-contents #(a b c))
+  #(a b c))
+
+(deftest make-array.2c
+  (make-array-with-checks 3 :initial-contents "abc")
+  #(#\a #\b #\c))
+
+(deftest make-array.2d
+  (make-array-with-checks 3 :initial-contents #*010)
+  #(0 1 0))
+
+(deftest make-array.3
+  (let ((a (make-array-with-checks 5 :element-type 'bit)))
+    (and (symbolp a) a))
+  nil)
+
+(deftest make-array.4
+  (make-array-with-checks 5 :element-type 'bit :initial-element 1)
+  #*11111)
+
+(deftest make-array.4a
+  (make-array-with-checks 5 :element-type 'bit :initial-contents '(1 0 0 1 0))
+  #*10010)
+
+(deftest make-array.4b
+  (make-array-with-checks 5 :element-type 'bit :initial-contents #(1 0 0 1 0))
+  #*10010)
+
+(deftest make-array.4c
+  (make-array-with-checks 5 :element-type 'bit :initial-contents #*10010)
+  #*10010)
+
+(deftest make-array.5
+  (let ((a (make-array-with-checks 4 :element-type 'character)))
+    (and (symbolp a) a))
+  nil)
+
+(deftest make-array.5a
+  (let ((a (make-array-with-checks '(4) :element-type 'character)))
+    (and (symbolp a) a))
+  nil)
+
+(deftest make-array.6
+  (make-array-with-checks 4 :element-type 'character
+			  :initial-element #\x)
+  "xxxx")
+
+(deftest make-array.6a
+  (make-array-with-checks 4 :element-type 'character
+			  :initial-contents '(#\a #\b #\c #\d))
+  "abcd")
+
+(deftest make-array.6b
+  (make-array-with-checks 4 :element-type 'character
+			  :initial-contents "abcd")
+  "abcd")
+
+(deftest make-array.7
+  (make-array-with-checks 5 :element-type 'symbol
+			  :initial-element 'a)
+  #(a a a a a))
+
+(deftest make-array.7a
+  (make-array-with-checks 5 :element-type 'symbol
+			  :initial-contents '(a b c d e))
+  #(a b c d e))
+
+(deftest make-array.7b
+  (make-array-with-checks '(5) :element-type 'symbol
+			  :initial-contents '(a b c d e))
+  #(a b c d e))
+
+(deftest make-array.8
+  (let ((a (make-array-with-checks 8 :element-type '(integer 0 (256)))))
+    (and (symbolp a) a))
+  nil)
+
+(deftest make-array.8a
+  (make-array-with-checks 8 :element-type '(integer 0 (256))
+			  :initial-element 9)
+  #(9 9 9 9 9 9 9 9))
+
+(deftest make-array.8b
+  (make-array-with-checks '(8) :element-type '(integer 0 (256))
+			  :initial-contents '(4 3 2 1 9 8 7 6))
+  #(4 3 2 1 9 8 7 6))
+
+;;; Zero dimensional arrays
+
+(deftest make-array.9
+  (let ((a (make-array-with-checks nil)))
+    (and (symbolp a) a))
+  nil)
+
+(deftest make-array.10
+  (make-array-with-checks nil :initial-element 1)
+  #0A1)
+
+(deftest make-array.11
+  (make-array-with-checks nil :initial-contents 2)
+  #0A2)
+
+(deftest make-array.12
+  (make-array-with-checks nil :element-type 'bit :initial-contents 1)
+  #0A1)
+
+(deftest make-array.13
+  (make-array-with-checks nil :element-type t :initial-contents 'a)
+  #0Aa)
+
+
+
+
+
+
+
+
diff --git a/ansi-tests/rt/rt.lsp b/ansi-tests/rt/rt.lsp
index 7c9c3fce885b28e4b69ee40d9aa36dc1cb2de646..b2d3038f24504e6873a12e6d5adaa993a040f58f 100644
--- a/ansi-tests/rt/rt.lsp
+++ b/ansi-tests/rt/rt.lsp
@@ -104,11 +104,17 @@
   (do-entry (get-entry name)))
 
 (defun equalp-with-case (x y)
+  "Like EQUALP, but doesn't do case conversion of characters.
+   Currently doesn't work on arrays of dimension > 1."
   (cond
    ((consp x)
     (and (consp y)
 	 (equalp-with-case (car x) (car y))
 	 (equalp-with-case (cdr x) (cdr y))))
+   ((and (typep x 'array)
+	 (typep y 'array)
+	 (not (eql (array-rank x) (array-rank y))))
+    nil)
    ((typep x 'vector)
     (and (typep y 'vector)
 	 (let ((x-len (length x))
@@ -118,6 +124,9 @@
 		 for e1 across x
 		 for e2 across y
 		 always (equalp-with-case e1 e2))))))
+   ((and (typep x 'array)
+	 (= (array-rank x) 0))
+    (equalp-with-case (aref x) (aref y)))
    (t (eql x y))))
 
 (defun do-entry (entry &optional