From 5f3c95cead0070d78c6b71a7dca8b1449f1305cd Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Thu, 20 Feb 2014 23:21:35 -0500
Subject: [PATCH] Add the same kludge in DIRECTORY-FILES for GCL as for CLISP.
 Fix DIRECTORY tests in test-utilities.script.

---
 TODO                       |  1 +
 test/test-utilities.script | 22 ++++++++++------------
 uiop/filesystem.lisp       |  2 +-
 3 files changed, 12 insertions(+), 13 deletions(-)

diff --git a/TODO b/TODO
index 17785c848..de7daf3bf 100644
--- a/TODO
+++ b/TODO
@@ -152,6 +152,7 @@
    which suggests brokenness in handler-bind and/or error.
 *** `#5(1 ,@`(2 3)))` returns #(1 2 3),
      rather than #(1 2 3 2 3 2 3 2 3) or even better #(1 2 3 3 3).
+*** (DIRECTORY #p"*.*") fails to match files with pathname type NIL.
 
 ** ABCL has a few bugs.
 *** ABCL fails the timestamp propagation test.
diff --git a/test/test-utilities.script b/test/test-utilities.script
index 9658c7fec..b497d7791 100644
--- a/test/test-utilities.script
+++ b/test/test-utilities.script
@@ -202,22 +202,20 @@
 (assert (directory-exists-p (subpathname *build-directory* "deleteme/a/b/e/")))
 (assert (probe-file* (subpathname *build-directory* "deleteme/a/1.x")))
 (assert (probe-file* (subpathname *build-directory* "deleteme/a/b/2")))
-;;; check to make sure DIRECTORY-FILES doesn't list subdirectories
+(DBG "check to make sure DIRECTORY-FILES doesn't list subdirectories")
 (let ((directory-a (directory-files (subpathname *build-directory* "deleteme/a/")))
       (directory-b (directory-files (subpathname *build-directory* "deleteme/a/b/"))))
-  (assert (every 'pathname-equal directory-a (list (subpathname *build-directory* "deleteme/a/1.x"))))
-  (assert (every 'pathname-equal directory-b (list (subpathname *build-directory* "deleteme/a/b/2")))))
-;;; check to make sure SUBDIRECTORIES does list subdirectories
+  (assert-pathnames-equal directory-a (list (subpathname *build-directory* "deleteme/a/1.x")))
+  (assert-pathnames-equal directory-b (list (subpathname *build-directory* "deleteme/a/b/2"))))
+(DBG "check to make sure SUBDIRECTORIES does list subdirectories")
 (let ((directory-a (subdirectories (subpathname *build-directory* "deleteme/a/")))
       (directory-b (subdirectories (subpathname *build-directory* "deleteme/a/b/"))))
-  (assert (set-equality directory-a
-                        (list (subpathname *build-directory* "deleteme/a/b/"))
-                        :test 'pathname-equal))
-  (assert (set-equality directory-b
-                        (list (subpathname *build-directory* "deleteme/a/b/c/")
-                              (subpathname *build-directory* "deleteme/a/b/d/")
-                              (subpathname *build-directory* "deleteme/a/b/e/"))
-                        :test 'pathname-equal)))
+  (assert-pathnames-equal directory-a (list (subpathname *build-directory* "deleteme/a/b/")))
+  (assert-pathnames-equal
+   (sort directory-b #'string< :key #'(lambda (x) (car (last (pathname-directory x)))))
+   (list (subpathname *build-directory* "deleteme/a/b/c/")
+	 (subpathname *build-directory* "deleteme/a/b/d/")
+	 (subpathname *build-directory* "deleteme/a/b/e/"))))
 (delete-empty-directory (subpathname *build-directory* "deleteme/a/b/e/"))
 (assert (not (directory-exists-p (subpathname *build-directory* "deleteme/a/b/e/"))))
 (delete-directory-tree (subpathname *build-directory* "deleteme/")
diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp
index 76be1bb0f..abad36244 100644
--- a/uiop/filesystem.lisp
+++ b/uiop/filesystem.lisp
@@ -212,7 +212,7 @@ permits this."
         (setf pattern (make-pathname-logical pattern (pathname-host dir))))
       (let* ((pat (merge-pathnames* pattern dir))
              (entries (append (ignore-errors (directory* pat))
-                              #+clisp
+                              #+(or clisp gcl)
                               (when (equal :wild (pathname-type pattern))
                                 (ignore-errors (directory* (make-pathname :type nil :defaults pat)))))))
         (remove-if 'directory-pathname-p
-- 
GitLab