From 9278f28a0be4f21cce90a78e746e06bdfbe1e68f Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Mon, 8 Jun 2015 13:40:02 -0400
Subject: [PATCH] Tests: better support case-independent filesystems in
 assert-pathname-equal.

---
 test/script-support.lisp   |  9 ++++++++-
 test/test-utilities.script | 12 ++++--------
 2 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/test/script-support.lisp b/test/script-support.lisp
index 39731bbe5..4496c9a66 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -167,8 +167,15 @@ Some constraints:
         the other expression ~S yields that:~%  ~S~%  ~S~%"
         qx x (pathname-components x)
         qy y (pathname-components y)))
+    ;; accept equalp namestrings, to account for case-independent filesystems
+    ((equalp (namestring x) (namestring y))
+     (warn "These two expressions yield pathnames that have equalp namestrings yet are not pathname-equal~%~
+        the first expression ~S yields this:~%  ~S~%  ~S~%
+        the other expression ~S yields that:~%  ~S~%  ~S~%"
+        qx x (pathname-components x)
+        qy y (pathname-components y)))
     (t
-     (error "These two expressions yield paths that are not pathname-equal~%~
+     (error "These two expressions yield paths that are equal in any way:~%~
         the first expression ~S yields this:~%  ~S~%  ~S~%
         the other expression ~S yields that:~%  ~S~%  ~S~%"
         qx x (pathname-components x)
diff --git a/test/test-utilities.script b/test/test-utilities.script
index 310451d35..c698b6151 100644
--- a/test/test-utilities.script
+++ b/test/test-utilities.script
@@ -8,13 +8,13 @@
    :ensure-directory t))
 
 (chdir *asdf-directory*)
-(assert (pathname-equal *asdf-directory* (getcwd)))
-(assert (pathname-equal *asdf-directory* (getcwd-from-run-program)))
+(assert-pathname-equal *asdf-directory* (getcwd)))
+(assert-pathname-equal *asdf-directory* (getcwd-from-run-program)))
 (assert (probe-file* "asdf.asd"))
 
 (chdir *test-directory*)
-(assert (pathname-equal *test-directory* (getcwd)))
-(assert (pathname-equal *test-directory* (getcwd-from-run-program)))
+(assert-pathname-equal *test-directory* (getcwd))
+(assert-pathname-equal *test-directory* (getcwd-from-run-program))
 (assert (probe-file* "test-utilities.script"))
 
 (assert
@@ -280,10 +280,6 @@
   (assert (not (base-string-p (strcat (basify "ab") #\c *last-char* (unbasify "d")))))
   (assert (base-string-p (strcat (basify "ab") #\c #\d))))
 
-(or #+os-windows ;; Avoid C:\Users vs C:\users on SBCL.
-    (equalp (namestring *test-directory*) (namestring (getcwd)))
-    (assert-pathname-equal *test-directory* (getcwd)))
-
 (assert-equal +crlf+ (map 'string 'code-char '(13 10)))
 (assert-equal +lf+ (map 'string 'code-char '(10)))
 (assert-equal +cr+ (map 'string 'code-char '(13)))
-- 
GitLab