suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

sort directory lists so operations are independent of filesystem directory order

Browse Source 
svn: r6930

original commit: 045b9e9ec7996991bf102fbbe99327463841f115
This commit is contained in:
Eli Barzilay 2007-07-17 09:38:53 +00:00
parent 56c8cafc5b
commit 84e2fa4c84
1 changed files with 22 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/mzlib/file.ss
View File

@ -185,6 +185,14 @@
(cond [(and name (regexp-match #rx#"[.]([^.]+)$" name)) => cadr] (cond [(and name (regexp-match #rx#"[.]([^.]+)$" name)) => cadr]
[else #f]))) [else #f])))
;; utility: sorted dirlist so functions are deterministic
(define/kw (sorted-dirlist . args)
(let* ([ps (apply directory-list args)]
[ps (map (lambda (p) (cons (path->string p) p)) ps)]
[ps (sort ps (lambda (p1 p2) (string<? (car p1) (car p2))))]
[ps (map cdr ps)])
ps))
(define (delete-directory/files path) (define (delete-directory/files path)
(unless (path-string? path) (unless (path-string? path)
(raise-type-error 'delete-directory/files "path or string" path)) (raise-type-error 'delete-directory/files "path or string" path))
@ -193,25 +201,24 @@
(delete-file path)] (delete-file path)]
[(directory-exists? path) [(directory-exists? path)
(for-each (lambda (e) (delete-directory/files (build-path path e))) (for-each (lambda (e) (delete-directory/files (build-path path e)))
(directory-list path)) (sorted-dirlist path))
(delete-directory path)] (delete-directory path)]
[else (error 'delete-directory/files [else (error 'delete-directory/files
"encountered ~a, neither a file nor a directory" "encountered ~a, neither a file nor a directory"
path)])) path)]))
(define (copy-directory/files src dest) (define (copy-directory/files src dest)
(cond (cond [(file-exists? src)
[(file-exists? src) (copy-file src dest)]
(copy-file src dest)] [(directory-exists? src)
[(directory-exists? src) (make-directory dest)
(make-directory dest) (for-each (lambda (e)
(for-each (lambda (e) (copy-directory/files (build-path src e)
(copy-directory/files (build-path src e) (build-path dest e)))
(build-path dest e))) (sorted-dirlist src))]
(directory-list src))] [else (error 'copy-directory/files
[else (error 'copy-directory/files "encountered ~a, neither a file nor a directory"
"encountered ~a, neither a file nor a directory" src)]))
src)]))
(define (make-directory* dir) (define (make-directory* dir)
(let-values ([(base name dir?) (split-path dir)]) (let-values ([(base name dir?) (split-path dir)])
@ -473,8 +480,7 @@
(case-lambda (case-lambda
[(acc) [(acc)
(do-paths (map (lambda (p) (build-path path p)) (do-paths (map (lambda (p) (build-path path p))
(sort (sorted-dirlist path))
(directory-list path) void))
acc)] acc)]
[(acc descend?) [(acc descend?)
(if descend? (descend acc) acc)])]) (if descend? (descend acc) acc)])])
@ -485,7 +491,7 @@
(define (do-paths paths acc) (define (do-paths paths acc)
(cond [(null? paths) acc] (cond [(null? paths) acc]
[else (do-paths (cdr paths) (do-path (car paths) acc))])) [else (do-paths (cdr paths) (do-path (car paths) acc))]))
(if path (do-path path init) (do-paths (directory-list) init))) (if path (do-path path init) (do-paths (sorted-dirlist) init)))
(define/kw (find-files f #:optional [path #f]) (define/kw (find-files f #:optional [path #f])
(reverse! (reverse!