~ chicken-core (chicken-5) /tests/test-find-files.scm

  1(import (chicken file)
  2        (chicken file posix)
  3        (chicken process-context)
  4        (chicken sort)
  5        (chicken string))
  6
  7(include "test.scm")
  8
  9(handle-exceptions exn
 10  'ignore
 11  (delete-directory "find-files-test-dir" #t))
 12
 13(define (file-list=? a b)
 14  (equal? (sort a string<?) (sort b string<?)))
 15
 16(for-each (lambda (d)
 17            (create-directory d #t))
 18          '("find-files-test-dir/foo/bar/baz/.quux"
 19            "find-files-test-dir/dir-link-target"
 20            "find-files-test-dir/foo/.x"))
 21
 22(for-each (lambda (f)
 23            (with-output-to-file f (cut display "")))
 24          '("find-files-test-dir/file1"
 25            "find-files-test-dir/file2"
 26            "find-files-test-dir/dir-link-target/foo"
 27            "find-files-test-dir/dir-link-target/bar"))
 28
 29(change-directory "find-files-test-dir")
 30
 31(cond-expand
 32  ((and windows (not cygwin))		; Cannot handle symlinks
 33   (define (path lst)
 34     (map (cut string-translate <> "/" "\\") lst)) )
 35  (else
 36   (create-symbolic-link "dir-link-target" "dir-link-name")
 37   (define (path lst) lst)))
 38
 39(test-begin "find-files")
 40
 41(test-equal "no keyword args"
 42            (find-files ".")
 43            (path 
 44	     `("./foo/bar/baz"
 45              "./foo/bar"
 46              "./foo"
 47              "./dir-link-target/foo"
 48              "./dir-link-target/bar"
 49              "./dir-link-target"
 50              "./file1"
 51	      ,@(cond-expand
 52		  ((and windows (not cygwin)) '())
 53		  (else '("./dir-link-name")))
 54              "./file2"))
 55            file-list=?)
 56
 57(test-equal "dotfiles: #t"
 58            (find-files "." dotfiles: #t)
 59	    (path
 60            `("./foo/bar/baz/.quux"
 61              "./foo/bar/baz"
 62              "./foo/bar"
 63              "./foo/.x"
 64              "./foo"
 65              "./dir-link-target/foo"
 66              "./dir-link-target/bar"
 67              "./dir-link-target"
 68              "./file1"
 69	      ,@(cond-expand
 70		  ((and windows (not cygwin)) '())
 71		  (else '("./dir-link-name")))
 72              "./file2"))
 73            file-list=?)
 74
 75(test-equal "follow-symlinks: #t"
 76            (find-files "." follow-symlinks: #t)
 77            (path
 78	     `("./foo/bar/baz"
 79              "./foo/bar"
 80              "./foo"
 81              "./dir-link-target/foo"
 82              "./dir-link-target/bar"
 83              "./dir-link-target"
 84              "./file1"
 85	      ,@(cond-expand
 86		  ((and windows (not cygwin)) '())
 87		  (else '("./dir-link-name/foo"
 88			  "./dir-link-name/bar"
 89			  "./dir-link-name")))
 90              "./file2"))
 91            file-list=?)
 92
 93(test-equal "limit: 1"
 94            (find-files "." limit: 1)
 95            (path
 96	     `("./foo/bar"
 97              "./foo"
 98              "./dir-link-target/foo"
 99              "./dir-link-target/bar"
100              "./dir-link-target"
101              "./file1"
102	      ,@(cond-expand
103		  ((and windows (not cygwin)) '())
104		  (else '("./dir-link-name")))
105              "./file2"))
106            file-list=?)
107
108(test-equal "limit: 1 follow-symlinks: #t"
109            (find-files "." limit: 1 follow-symlinks: #t)
110	    (path
111            `("./foo/bar"
112              "./foo"
113              "./dir-link-target/foo"
114              "./dir-link-target/bar"
115              "./dir-link-target"
116              "./file1"
117	      ,@(cond-expand
118		  ((and windows (not cygwin)) '())
119		  (else '("./dir-link-name/foo"
120			  "./dir-link-name/bar"
121			  "./dir-link-name")))
122              "./file2"))
123            file-list=?)
124
125(test-equal "limit: 2"
126            (find-files "." limit: 2)
127	    (path
128            `("./foo/bar/baz"
129              "./foo/bar"
130              "./foo"
131              "./dir-link-target/foo"
132              "./dir-link-target/bar"
133              "./dir-link-target"
134              "./file1"
135	      ,@(cond-expand
136		  ((and windows (not cygwin)) '())
137		  (else '("./dir-link-name")))
138              "./file2"))
139            file-list=?)
140
141(test-equal "limit: 2 follow-symlinks: #t"
142            (find-files "." limit: 2 follow-symlinks: #t)
143	    (path
144            `("./foo/bar/baz"
145              "./foo/bar"
146              "./foo"
147              "./dir-link-target/foo"
148              "./dir-link-target/bar"
149              "./dir-link-target"
150              "./file1"
151	      ,@(cond-expand
152		  ((and windows (not cygwin)) '())
153		  (else '("./dir-link-name/foo"
154			  "./dir-link-name/bar"
155			  "./dir-link-name")))
156              "./file2"))
157            file-list=?)
158
159(test-equal "test: (lambda (f) (directory? f))"
160            (find-files "." test: (lambda (f) (directory? f)))
161            (path
162	     `("./foo/bar/baz"
163              "./foo/bar"
164              "./foo"
165              "./dir-link-target"
166	      ,@(cond-expand
167		  ((and windows (not cygwin)) '())
168		  (else '("./dir-link-name")))))
169            file-list=?)
170
171(test-equal "test: (lambda (f) (directory? f)) action: (lambda (f p) (cons (string-append \"--\" f) p))"
172            (find-files "."
173                        test: (lambda (f) (directory? f))
174                        action: (lambda (f p) (cons (string-append "--" f) p)))
175            (path
176	     `("--./foo/bar/baz"
177              "--./foo/bar"
178              "--./foo"
179              "--./dir-link-target"
180	      ,@(cond-expand
181		  ((and windows (not cygwin)) '())
182		  (else '("--./dir-link-name")))))
183            file-list=?)
184
185(test-equal "dotfiles: #t test: (lambda (f) (directory? f)) follow-symlinks: #t"
186            (find-files "." dotfiles: #t test: (lambda (f) (directory? f)) follow-symlinks: #t)
187            (path
188	     `("./foo/bar/baz/.quux"
189              "./foo/bar/baz"
190              "./foo/bar"
191              "./foo/.x"
192              "./foo"
193              "./dir-link-target"
194	      ,@(cond-expand
195		  ((and windows (not cygwin)) '())
196		  (else '("./dir-link-name")))))
197            file-list=?)
198
199(test-equal "dotfiles: #t test: (lambda (f) (directory? f)) follow-symlinks: #t limit: 1"
200            (find-files "."
201                        dotfiles: #t
202                        test: (lambda (f) (directory? f))
203                        follow-symlinks: #t
204                        limit: 1)
205            (path
206	     `("./foo/bar"
207              "./foo/.x"
208              "./foo"
209              "./dir-link-target"
210	      ,@(cond-expand
211		  ((and windows (not cygwin)) '())
212		  (else '("./dir-link-name")))))
213            file-list=?)
214
215(test-end "find-files")
216
217(change-directory "..")
218(delete-directory "find-files-test-dir" #t)
219
220(test-exit)