>From 082efb3500bff00e607aabe3c9158029c24cf6e1 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Sat, 6 Jan 2018 17:12:27 +1300 Subject: [PATCH] Make `glob' skip nonexistent/unreadable directories --- chicken-install.scm | 6 +----- file.scm | 31 ++++++++++++++++--------------- tests/test-glob.scm | 13 ++++++++++++- 3 files changed, 29 insertions(+), 21 deletions(-) diff --git a/chicken-install.scm b/chicken-install.scm index 9d37eb32..31e5dc49 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 (append (glob "*.egg") (glob "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/*"))) -- 2.11.0