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