diff --git a/test/script-support.lisp b/test/script-support.lisp index 20f0160d785db5ce30ea0901163884730069b922..39b8be0803185e94186d0de7ef8565b71d22c426 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 3daaaf26031ba299457e3d7aebc9764fd8f30fd3..da59392b9a2f2f8024a952aed56f5225b5fa77b7 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/")