~ chicken-core (chicken-5) 773164a7d37f73cb2f0ee3cc813fb4d8620714f7
commit 773164a7d37f73cb2f0ee3cc813fb4d8620714f7
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 16:32:21 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 a6323df7..e2dc40a5 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -137,6 +137,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 44985608..c00e525a 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -428,6 +428,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 18dee088..e7be96fc 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -346,6 +346,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