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

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

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

revision 1.11 by pfdietz, Tue Jul 1 12:16:10 2003 UTC revision 1.12 by pfdietz, Sat Jul 12 13:46:01 2003 UTC
# Line 159  Line 159 
159  (defun do-test (&optional (name *test*))  (defun do-test (&optional (name *test*))
160    (do-entry (get-entry name)))    (do-entry (get-entry name)))
161    
162    (defun my-aref (a &rest args)
163      (apply #'aref a args))
164    
165    (defun my-row-major-aref (a index)
166      (row-major-aref a index))
167    
168  (defun equalp-with-case (x y)  (defun equalp-with-case (x y)
169    "Like EQUALP, but doesn't do case conversion of characters.    "Like EQUALP, but doesn't do case conversion of characters.
170     Currently doesn't work on arrays of dimension > 2."     Currently doesn't work on arrays of dimension > 2."
# Line 170  Line 176 
176           (equalp-with-case (cdr x) (cdr y))))           (equalp-with-case (cdr x) (cdr y))))
177     ((and (typep x 'array)     ((and (typep x 'array)
178           (= (array-rank x) 0))           (= (array-rank x) 0))
179      (equalp-with-case (aref x) (aref y)))      (equalp-with-case (my-aref x) (my-aref y)))
180     ((typep x 'vector)     ((typep x 'vector)
181      (and (typep y 'vector)      (and (typep y 'vector)
182           (let ((x-len (length x))           (let ((x-len (length x))
183                 (y-len (length y)))                 (y-len (length y)))
184             (and (eql x-len y-len)             (and (eql x-len y-len)
185                  (loop                  (loop
186                   for e1 across x                   for i from 0 below x-len
187                   for e2 across y                   for e1 = (my-aref x i)
188                     for e2 = (my-aref y i)
189                   always (equalp-with-case e1 e2))))))                   always (equalp-with-case e1 e2))))))
190     ((and (typep x 'array)     ((and (typep x 'array)
191           (typep y 'array)           (typep y 'array)
# Line 190  Line 197 
197      (and (typep y 'array)      (and (typep y 'array)
198           (let ((size (array-total-size x)))           (let ((size (array-total-size x)))
199             (loop for i from 0 below size             (loop for i from 0 below size
200                   always (equalp-with-case (row-major-aref x i)                   always (equalp-with-case (my-row-major-aref x i)
201                                            (row-major-aref y i))))))                                            (my-row-major-aref y i))))))
202    
203     (t (eql x y))))     (t (eql x y))))
204    
# Line 346  Line 353 
353  ;;; Note handling functions and macros  ;;; Note handling functions and macros
354    
355  (defmacro defnote (name contents &optional disabled)  (defmacro defnote (name contents &optional disabled)
356    `(eval-when #+gcl (load eval) #-gcl (:load-toplevel :execute)    `(eval-when (:load-toplevel :execute)
357       (let ((note (make-note :name ',name       (let ((note (make-note :name ',name
358                              :contents ',contents                              :contents ',contents
359                              :disabled ',disabled)))                              :disabled ',disabled)))

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

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