/[gcl]/gcl/ansi-tests/rt/rt.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/rt/rt.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by pfdietz, Thu Jan 2 13:00:51 2003 UTC revision 1.6 by pfdietz, Thu Jan 2 13:19:15 2003 UTC
# Line 105  Line 105 
105    
106  (defun equalp-with-case (x y)  (defun equalp-with-case (x y)
107    "Like EQUALP, but doesn't do case conversion of characters.    "Like EQUALP, but doesn't do case conversion of characters.
108     Currently doesn't work on arrays of dimension > 1."     Currently doesn't work on arrays of dimension > 2."
109    (cond    (cond
110     ((consp x)     ((consp x)
111      (and (consp y)      (and (consp y)
112           (equalp-with-case (car x) (car y))           (equalp-with-case (car x) (car y))
113           (equalp-with-case (cdr x) (cdr y))))           (equalp-with-case (cdr x) (cdr y))))
114     ((and (typep x 'array)     ((and (typep x 'array)
115           (typep y 'array)           (= (array-rank x) 0))
116           (not (eql (array-rank x) (array-rank y))))      (equalp-with-case (aref x) (aref y)))
     nil)  
117     ((typep x 'vector)     ((typep x 'vector)
118      (and (typep y 'vector)      (and (typep y 'vector)
119           (let ((x-len (length x))           (let ((x-len (length x))
# Line 125  Line 124 
124                   for e2 across y                   for e2 across y
125                   always (equalp-with-case e1 e2))))))                   always (equalp-with-case e1 e2))))))
126     ((and (typep x 'array)     ((and (typep x 'array)
127           (= (array-rank x) 0))           (typep y 'array)
128      (equalp-with-case (aref x) (aref y)))           (not (equal (array-dimensions x)
129                         (array-dimensions y))))
130        nil)
131       ;; I should use ROW-MAJOR-AREF to do this, but that's broken
132       ;; in GCL right now.
133       ((and (typep x 'array)
134             (= (array-rank x) 2))
135        (let ((dim (array-dimensions x)))
136          (loop for i from 0 below (first dim)
137                always (loop for j from 0 below (second dim)
138                             always (equalp-with-case (aref x i j)
139                                                      (aref y i j))))))
140     (t (eql x y))))     (t (eql x y))))
141    
142  (defun do-entry (entry &optional  (defun do-entry (entry &optional

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26