~ chicken-core (chicken-5) 52db781fe25566b6b3efc938363a89de7c564ee9
commit 52db781fe25566b6b3efc938363a89de7c564ee9
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Sat Jan 6 17:12:27 2018 +1300
Commit: Kooda <kooda@upyum.com>
CommitDate: Mon Jan 15 10:45:03 2018 +0100
Make `glob' skip nonexistent/unreadable directories
Signed-off-by: Kooda <kooda@upyum.com>
diff --git a/NEWS b/NEWS
index 3a51fca0..30a9c344 100644
--- a/NEWS
+++ b/NEWS
@@ -74,6 +74,8 @@
- The procedures for random numbers have been reimplemented;
access to system-specific entropy is available, together with a reasonably
good pseudo random number generator (WELL512).
+ - `glob` now returns an empty list for non-existent or inaccessible
+ directories, instead of erroring out.
- Module system
- The compiler has been modularised, for improved namespacing. This
diff --git a/chicken-install.scm b/chicken-install.scm
index 9d37eb32..918b5c8a 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -983,11 +983,7 @@
((null? eggs)
(if list-versions-only
(print "no eggs specified")
- (let ((files (append (glob "*.egg")
- (if (and (file-exists? "chicken")
- (directory? "chicken"))
- (glob "chicken/*.egg")
- '()))))
+ (let ((files (glob "*.egg" "chicken/*.egg")))
(set! canonical-eggs
(map (lambda (fname)
(list (pathname-file fname) (current-directory) #f))
diff --git a/file.scm b/file.scm
index 82fd866b..5a0a1bf1 100644
--- a/file.scm
+++ b/file.scm
@@ -297,21 +297,22 @@ EOF
;;; Filename globbing:
-(define glob
- (lambda paths
- (let conc-loop ((paths paths))
- (if (null? paths)
- '()
- (let ((path (car paths)))
- (let-values (((dir fil ext) (decompose-pathname path)))
- (let ((rx (irregex (glob->sre (make-pathname #f (or fil "*") ext)))))
- (let loop ((fns (directory (or dir ".") #t)))
- (cond ((null? fns) (conc-loop (cdr paths)))
- ((irregex-match rx (car fns)) =>
- (lambda (m)
- (cons (make-pathname dir (irregex-match-substring m))
- (loop (cdr fns)))))
- (else (loop (cdr fns))))))))))))
+(define (glob . paths)
+ (let conc-loop ((paths paths))
+ (if (null? paths)
+ '()
+ (let ((path (car paths)))
+ (let-values (((dir fil ext) (decompose-pathname path)))
+ (let ((dir* (or dir "."))
+ (rx (irregex (glob->sre (make-pathname #f (or fil "*") ext)))))
+ (let loop ((fns (condition-case (directory dir* #t)
+ ((exn i/o file) #f))))
+ (cond ((not (pair? fns)) (conc-loop (cdr paths)))
+ ((irregex-match rx (car fns)) =>
+ (lambda (m)
+ (cons (make-pathname dir (irregex-match-substring m))
+ (loop (cdr fns)))))
+ (else (loop (cdr fns)))))))))))
;;; Find matching files:
diff --git a/tests/test-glob.scm b/tests/test-glob.scm
index 9bba8e71..16fd22f1 100644
--- a/tests/test-glob.scm
+++ b/tests/test-glob.scm
@@ -1,5 +1,7 @@
-;;;; test-glob.scm - test glob-pattern -> regex translation
+;;;; test-glob.scm
+
+;; test glob-pattern -> regex translation
(import (chicken irregex))
@@ -18,3 +20,12 @@
(assert (not (irregex-match (glob->sre "main.[ch]") "main.cpp")))
(assert (irregex-match (glob->sre "main.[-c]") "main.h"))
(assert (not (irregex-match (glob->sre "main.[-h]") "main.h")))
+
+;; test file globbing
+
+(import (chicken file))
+
+(assert (pair? (glob "../tests")))
+(assert (pair? (glob "../tests/*")))
+(assert (null? (glob "../nowhere")))
+(assert (null? (glob "../nowhere/*")))
Trap