Any thoughts on this patch?
>From 711ca0a5ed7351d6fde360f9b451600e77403522 Mon Sep 17 00:00:00 2001 From: Andy Wingo <wi...@pobox.com> Date: Mon, 11 Jun 2012 12:25:24 +0200 Subject: [PATCH] scandir: select? takes basenames, operates on (sub)dirs also
* module/ice-9/ftw.scm (scandir): Run the select? procedure on all items, including subdirs and the `.' and `..' entries. Pass it the basename of the file in question instead of the full name. * test-suite/tests/ftw.test ("scandir"): Adapt expectation for the .test selector. Add test for a selector that rejects everything. --- module/ice-9/ftw.scm | 19 +++++++++++-------- test-suite/tests/ftw.test | 7 +++++-- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/module/ice-9/ftw.scm b/module/ice-9/ftw.scm index 96422b5..6c9db27 100644 --- a/module/ice-9/ftw.scm +++ b/module/ice-9/ftw.scm @@ -538,26 +538,29 @@ of file names is sorted according to ENTRY<?, which defaults to (define (enter? dir stat result) (and stat (string=? dir name))) - (define (leaf name stat result) - (if (select? name) - (and (pair? result) ; must have a "." entry - (cons (basename name) result)) + (define (visit basename result) + (if (select? basename) + (cons basename result) result)) + (define (leaf name stat result) + (and result + (visit (basename name) result))) + (define (down name stat result) - (list ".")) + (visit "." '())) (define (up name stat result) - (cons ".." result)) + (visit ".." result)) (define (skip name stat result) ;; All the sub-directories are skipped. - (cons (basename name) result)) + (visit (basename name) result)) (define (error name* stat errno result) (if (string=? name name*) ; top-level NAME is unreadable result - (cons (basename name*) result))) + (visit (basename name*) result))) (and=> (file-system-fold enter? leaf down up skip error #f name stat) (lambda (files) diff --git a/test-suite/tests/ftw.test b/test-suite/tests/ftw.test index 805c779..33537d0 100644 --- a/test-suite/tests/ftw.test +++ b/test-suite/tests/ftw.test @@ -310,14 +310,17 @@ (pass-if "test-suite" (let ((select? (cut string-suffix? ".test" <>))) (match (scandir (string-append %test-dir "/tests") select?) - (("." ".." "00-initial-env.test" (? select?) ...) + (("00-initial-env.test" (? select?) ...) #t)))) (pass-if "flat file" (not (scandir (string-append %test-dir "/Makefile.am")))) (pass-if "EACCES" - (not (scandir "/.does-not-exist.")))) + (not (scandir "/.does-not-exist."))) + + (pass-if "no select" + (null? (scandir %test-dir (lambda (_) #f))))) ;;; Local Variables: ;;; eval: (put 'with-file-tree 'scheme-indent-function 2) -- 1.7.10
-- http://wingolog.org/