~ 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