From 3ea8aaa27e9d48e89246bb698c9c56bfdd73b698 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Tue, 1 Oct 2002 12:41:27 +0000 Subject: [PATCH] Modified so that instead of using EQUALP, uses EQUALP-WITH-CASE (which is kind of like EQUALP but preserves case in comparison of characters.) --- ansi-tests/rt/rt.lsp | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/ansi-tests/rt/rt.lsp b/ansi-tests/rt/rt.lsp index 8ed16f43..d00b2cdb 100644 --- a/ansi-tests/rt/rt.lsp +++ b/ansi-tests/rt/rt.lsp @@ -101,6 +101,23 @@ (defun do-test (&optional (name *test*)) (do-entry (get-entry name))) +(defun equalp-with-case (x y) + (cond + ((consp x) + (and (consp y) + (equalp-with-case (car x) (car y)) + (equalp-with-case (cdr x) (cdr y)))) + ((typep x 'vector) + (and (typep y 'vector) + (let ((x-len (length x)) + (y-len (length y))) + (and (eql x-len y-len) + (loop + for e1 across x + for e2 across y + always (equalp-with-case e1 e2)))))) + (t (eql x y)))) + (defun do-entry (entry &optional (s *standard-output*)) (catch '*in-test* @@ -117,7 +134,7 @@ (declare (special *break-on-warnings*)) (setf (pend entry) (or aborted - (not (equalp r (vals entry))))) + (not (equalp-with-case r (vals entry))))) (when (pend entry) (format s "~&Test ~:@(~S~) failed~ ~%Form: ~S~ -- GitLab