/[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.4 by pfdietz, Wed Dec 18 04:01:33 2002 UTC revision 1.5 by pfdietz, Thu Jan 2 13:00:51 2003 UTC
# Line 104  Line 104 
104    (do-entry (get-entry name)))    (do-entry (get-entry name)))
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.
108       Currently doesn't work on arrays of dimension > 1."
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)
115             (typep y 'array)
116             (not (eql (array-rank x) (array-rank y))))
117        nil)
118     ((typep x 'vector)     ((typep x 'vector)
119      (and (typep y 'vector)      (and (typep y 'vector)
120           (let ((x-len (length x))           (let ((x-len (length x))
# Line 118  Line 124 
124                   for e1 across x                   for e1 across x
125                   for e2 across y                   for e2 across y
126                   always (equalp-with-case e1 e2))))))                   always (equalp-with-case e1 e2))))))
127       ((and (typep x 'array)
128             (= (array-rank x) 0))
129        (equalp-with-case (aref x) (aref y)))
130     (t (eql x y))))     (t (eql x y))))
131    
132  (defun do-entry (entry &optional  (defun do-entry (entry &optional

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

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