From 74aec2b38fa640decc1c8c40bd0e3307ce217785 Mon Sep 17 00:00:00 2001
From: "Robert P. Goldman" <rpgoldman@gmail.com>
Date: Sun, 9 Feb 2014 19:56:18 -0600
Subject: [PATCH] Add new tests for directory functions.

Test for DIRECTORY-FILES returning only files; text for SUBDIRECTORIES
returning only subdirectories.

According to Fare, DIRECTORY-FILES should *not* return subdirectories,
but it does on several implementations.  See
https://bugs.launchpad.net/asdf/+bug/1276748
---
 test/script-support.lisp   |  8 ++++++++
 test/test-utilities.script | 16 ++++++++++++++++
 2 files changed, 24 insertions(+)

diff --git a/test/script-support.lisp b/test/script-support.lisp
index 20f0160d7..39b8be080 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -241,6 +241,14 @@ Some constraints:
 (defmacro assert-equal (x y)
   `(assert-compare (equal ,x ,y)))
 
+(defun set-equality (s1 s2 &key (test 'eql))
+  (and (= (length s1) (length s2))
+       (every #'(lambda (x)
+                  (some #'(lambda (y)
+                            (funcall test x y))
+                        s2))
+              s1)))
+
 (defun touch-file (file &key offset timestamp in-filesystem)
   (let* ((base (or timestamp (get-universal-time)))
          (stamp (if offset (+ base offset) base)))
diff --git a/test/test-utilities.script b/test/test-utilities.script
index 3daaaf260..da59392b9 100644
--- a/test/test-utilities.script
+++ b/test/test-utilities.script
@@ -192,6 +192,22 @@
 (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
+(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
+(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)))
 (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/")
-- 
GitLab