~ chicken-core (chicken-5) 540ab9c19653c4fd9c4ef7c5c7c0d4d99e528270
commit 540ab9c19653c4fd9c4ef7c5c7c0d4d99e528270
Author: Mario Domenech Goulart <mario.goulart@gmail.com>
AuthorDate: Tue Jun 2 22:07:27 2015 -0300
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Fri Jun 12 10:41:25 2015 +1200
Add test suite for find-files
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/distribution/manifest b/distribution/manifest
index 12858585..4ef3d1dc 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -140,6 +140,7 @@ tests/module-tests.scm
tests/module-tests-2.scm
tests/test-finalizers.scm
tests/test-finalizers-2.scm
+tests/test-find-files.scm
tests/module-tests-compiled.scm
tests/scrutiny-tests.scm
tests/scrutiny-tests-strict.scm
diff --git a/tests/runtests.bat b/tests/runtests.bat
index 942e234b..b6ef378a 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -418,6 +418,10 @@ echo 0 >tmpdir\.dotfile
%interpret% -R posix -e "(delete-directory \"tmpdir\" #t)"
if errorlevel 1 exit /b 1
+echo ======================================== find-files tests ...
+%interpret% -bnq test-find-files.scm
+if errorlevel 1 exit /b 1
+
echo ======================================== regular expression tests ...
%interpret% -bnq test-irregex.scm
if errorlevel 1 exit /b 1
diff --git a/tests/runtests.sh b/tests/runtests.sh
index ba4449eb..7e078ff1 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -344,6 +344,9 @@ rm -fr tmpdir
mkdir tmpdir
touch tmpdir/.dotfile
+echo "======================================== find-files tests ..."
+$interpret -bnq test-find-files.scm
+
if test -z "$MSYSTEM"; then
ln -s /usr tmpdir/symlink
fi
diff --git a/tests/test-find-files.scm b/tests/test-find-files.scm
new file mode 100644
index 00000000..10537686
--- /dev/null
+++ b/tests/test-find-files.scm
@@ -0,0 +1,160 @@
+(use posix)
+(include "test.scm")
+
+(handle-exceptions exn
+ 'ignore
+ (delete-directory "find-files-test-dir" #t))
+
+(for-each (lambda (d)
+ (create-directory d #t))
+ '("find-files-test-dir/foo/bar/baz/.quux"
+ "find-files-test-dir/dir-link-target"
+ "find-files-test-dir/foo/.x"))
+
+(for-each (lambda (f)
+ (with-output-to-file f (cut display "")))
+ '("find-files-test-dir/file1"
+ "find-files-test-dir/file2"
+ "find-files-test-dir/dir-link-target/foo"
+ "find-files-test-dir/dir-link-target/bar"))
+
+(change-directory "find-files-test-dir")
+
+(create-symbolic-link "dir-link-target" "dir-link-name")
+
+(test-begin "find-files")
+
+(test-equal "no keyword args"
+ (find-files ".")
+ '("./foo/bar/baz"
+ "./foo/bar"
+ "./foo"
+ "./dir-link-target/foo"
+ "./dir-link-target/bar"
+ "./dir-link-target"
+ "./file1"
+ "./dir-link-name"
+ "./file2"))
+
+(test-equal "dotfiles: #t"
+ (find-files "." dotfiles: #t)
+ '("./foo/bar/baz/.quux"
+ "./foo/bar/baz"
+ "./foo/bar"
+ "./foo/.x"
+ "./foo"
+ "./dir-link-target/foo"
+ "./dir-link-target/bar"
+ "./dir-link-target"
+ "./file1"
+ "./dir-link-name"
+ "./file2"))
+
+(test-equal "follow-symlinks: #t"
+ (find-files "." follow-symlinks: #t)
+ '("./foo/bar/baz"
+ "./foo/bar"
+ "./foo"
+ "./dir-link-target/foo"
+ "./dir-link-target/bar"
+ "./dir-link-target"
+ "./file1"
+ "./dir-link-name/foo"
+ "./dir-link-name/bar"
+ "./dir-link-name"
+ "./file2"))
+
+(test-equal "limit: 1"
+ (find-files "." limit: 1)
+ '("./foo/bar"
+ "./foo"
+ "./dir-link-target/foo"
+ "./dir-link-target/bar"
+ "./dir-link-target"
+ "./file1"
+ "./dir-link-name"
+ "./file2"))
+
+(test-equal "limit: 1 follow-symlinks: #t"
+ (find-files "." limit: 1 follow-symlinks: #t)
+ '("./foo/bar"
+ "./foo"
+ "./dir-link-target/foo"
+ "./dir-link-target/bar"
+ "./dir-link-target"
+ "./file1"
+ "./dir-link-name/foo"
+ "./dir-link-name/bar"
+ "./dir-link-name"
+ "./file2"))
+
+(test-equal "limit: 2"
+ (find-files "." limit: 2)
+ '("./foo/bar/baz"
+ "./foo/bar"
+ "./foo"
+ "./dir-link-target/foo"
+ "./dir-link-target/bar"
+ "./dir-link-target"
+ "./file1"
+ "./dir-link-name"
+ "./file2"))
+
+(test-equal "limit: 2 follow-symlinks: #t"
+ (find-files "." limit: 2 follow-symlinks: #t)
+ '("./foo/bar/baz"
+ "./foo/bar"
+ "./foo"
+ "./dir-link-target/foo"
+ "./dir-link-target/bar"
+ "./dir-link-target"
+ "./file1"
+ "./dir-link-name/foo"
+ "./dir-link-name/bar"
+ "./dir-link-name"
+ "./file2"))
+
+(test-equal "test: (lambda (f) (directory? f))"
+ (find-files "." test: (lambda (f) (directory? f)))
+ '("./foo/bar/baz"
+ "./foo/bar"
+ "./foo"
+ "./dir-link-target"
+ "./dir-link-name"))
+
+(test-equal "test: (lambda (f) (directory? f)) action: (lambda (f p) (cons (string-append \"--\" f) p))"
+ (find-files "."
+ test: (lambda (f) (directory? f))
+ action: (lambda (f p) (cons (string-append "--" f) p)))
+ '("--./foo/bar/baz"
+ "--./foo/bar"
+ "--./foo"
+ "--./dir-link-target"
+ "--./dir-link-name"))
+
+(test-equal "dotfiles: #t test: (lambda (f) (directory? f)) follow-symlinks: #t"
+ (find-files "." dotfiles: #t test: (lambda (f) (directory? f)) follow-symlinks: #t)
+ '("./foo/bar/baz/.quux"
+ "./foo/bar/baz"
+ "./foo/bar"
+ "./foo/.x"
+ "./foo"
+ "./dir-link-target"
+ "./dir-link-name"))
+
+(test-equal "dotfiles: #t test: (lambda (f) (directory? f)) follow-symlinks: #t limit: 1"
+ (find-files "."
+ dotfiles: #t
+ test: (lambda (f) (directory? f))
+ follow-symlinks: #t
+ limit: 1)
+ '("./foo/bar"
+ "./foo/.x"
+ "./foo"
+ "./dir-link-target"
+ "./dir-link-name"))
+
+(test-end "find-files")
+
+(change-directory "..")
+(delete-directory "find-files-test-dir" #t)
Trap