From 1a65162b51ae8aa5f93fd8f97b9d89e6bd4b8ee8 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Thu, 2 Jan 2003 13:19:15 +0000
Subject: [PATCH] Extended EQUALP-WITH-CASE to two dimensional arrays.

---
 ansi-tests/rt/rt.lsp | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

diff --git a/ansi-tests/rt/rt.lsp b/ansi-tests/rt/rt.lsp
index b2d3038f..195c0b9c 100644
--- a/ansi-tests/rt/rt.lsp
+++ b/ansi-tests/rt/rt.lsp
@@ -105,16 +105,15 @@
 
 (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."
+   Currently doesn't work on arrays of dimension > 2."
   (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)
+	 (= (array-rank x) 0))
+    (equalp-with-case (aref x) (aref y)))
    ((typep x 'vector)
     (and (typep y 'vector)
 	 (let ((x-len (length x))
@@ -125,8 +124,19 @@
 		 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)))
+	 (typep y 'array)
+	 (not (equal (array-dimensions x)
+		     (array-dimensions y))))
+    nil)
+   ;; I should use ROW-MAJOR-AREF to do this, but that's broken
+   ;; in GCL right now.
+   ((and (typep x 'array)
+	 (= (array-rank x) 2))
+    (let ((dim (array-dimensions x)))
+      (loop for i from 0 below (first dim)
+	    always (loop for j from 0 below (second dim)
+			 always (equalp-with-case (aref x i j)
+						  (aref y i j))))))
    (t (eql x y))))
 
 (defun do-entry (entry &optional
-- 
GitLab