~ 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