Commit 74aec2b3 authored by Robert P. Goldman's avatar Robert P. Goldman

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
parent 361fa5d7
......@@ -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)))
......
......@@ -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/")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment