- (let ((piece (car tail)))
- (etypecase piece
- (simple-string
- (let ((head (concatenate 'string head piece)))
- (with-directory-node-noted (head)
- (%enumerate-directories (concatenate 'string head "/")
- (cdr tail) pathname
- verify-existence follow-links
- nodes function))))
- ((member :wild-inferiors)
- (%enumerate-directories head (rest tail) pathname
- verify-existence follow-links
- nodes function)
- (dolist (name (ignore-errors (directory-lispy-filenames head)))
- (let ((subdir (concatenate 'string head name)))
- (multiple-value-bind (res dev ino mode)
- (unix-xstat subdir)
- (declare (type (or fixnum null) mode))
- (when (and res (eql (logand mode sb!unix:s-ifmt)
- sb!unix:s-ifdir))
- (unless (dolist (dir nodes nil)
- (when (and (eql (car dir) dev)
- (eql (cdr dir) ino))
- (return t)))
- (let ((nodes (cons (cons dev ino) nodes))
- (subdir (concatenate 'string subdir "/")))
- (%enumerate-directories subdir tail pathname
- verify-existence follow-links
- nodes function))))))))
- ((or pattern (member :wild))
- (dolist (name (directory-lispy-filenames head))
- (when (or (eq piece :wild) (pattern-matches piece name))
- (let ((subdir (concatenate 'string head name)))
- (multiple-value-bind (res dev ino mode)
- (unix-xstat subdir)
- (declare (type (or fixnum null) mode))
- (when (and res
- (eql (logand mode sb!unix:s-ifmt)
- sb!unix:s-ifdir))
- (let ((nodes (cons (cons dev ino) nodes))
- (subdir (concatenate 'string subdir "/")))
- (%enumerate-directories subdir (rest tail) pathname
- verify-existence follow-links
- nodes function))))))))
- ((member :up)
- (let ((head (concatenate 'string head "..")))
- (with-directory-node-noted (head)
- (%enumerate-directories (concatenate 'string head "/")
- (rest tail) pathname
- verify-existence follow-links
- nodes function))))))
- (%enumerate-files head pathname verify-existence function))))
+ (let ((piece (car tail)))
+ (etypecase piece
+ (simple-string
+ (let ((head (concatenate 'base-string head piece)))
+ (with-directory-node-noted (head)
+ (%enumerate-directories (concatenate 'base-string head "/")
+ (cdr tail) pathname
+ verify-existence follow-links
+ nodes function))))
+ ((member :wild-inferiors)
+ ;; now with extra error case handling from CLHS
+ ;; 19.2.2.4.3 -- CSR, 2004-01-24
+ (when (member (cadr tail) '(:up :back))
+ (error 'simple-file-error
+ :pathname pathname
+ :format-control "~@<invalid use of ~S after :WILD-INFERIORS~@:>."
+ :format-arguments (list (cadr tail))))
+ (%enumerate-directories head (rest tail) pathname
+ verify-existence follow-links
+ nodes function)
+ (dolist (name (ignore-errors (directory-lispy-filenames head)))
+ (let ((subdir (concatenate 'base-string head name)))
+ (multiple-value-bind (res dev ino mode)
+ (unix-xstat subdir)
+ (declare (type (or fixnum null) mode))
+ (when (and res (eql (logand mode sb!unix:s-ifmt)
+ sb!unix:s-ifdir))
+ (unless (dolist (dir nodes nil)
+ (when (and (eql (car dir) dev)
+ (eql (cdr dir) ino))
+ (return t)))
+ (let ((nodes (cons (cons dev ino) nodes))
+ (subdir (concatenate 'base-string subdir "/")))
+ (%enumerate-directories subdir tail pathname
+ verify-existence follow-links
+ nodes function))))))))
+ ((or pattern (member :wild))
+ (dolist (name (directory-lispy-filenames head))
+ (when (or (eq piece :wild) (pattern-matches piece name))
+ (let ((subdir (concatenate 'base-string head name)))
+ (multiple-value-bind (res dev ino mode)
+ (unix-xstat subdir)
+ (declare (type (or fixnum null) mode))
+ (when (and res
+ (eql (logand mode sb!unix:s-ifmt)
+ sb!unix:s-ifdir))
+ (let ((nodes (cons (cons dev ino) nodes))
+ (subdir (concatenate 'base-string subdir "/")))
+ (%enumerate-directories subdir (rest tail) pathname
+ verify-existence follow-links
+ nodes function))))))))
+ ((member :up)
+ (when (string= head "/")
+ (error 'simple-file-error
+ :pathname pathname
+ :format-control "~@<invalid use of :UP after :ABSOLUTE.~@:>"))
+ (with-directory-node-removed (head)
+ (let ((head (concatenate 'base-string head "..")))
+ (with-directory-node-noted (head)
+ (%enumerate-directories (concatenate 'base-string head "/")
+ (rest tail) pathname
+ verify-existence follow-links
+ nodes function)))))
+ ((member :back)
+ ;; :WILD-INFERIORS is handled above, so the only case here
+ ;; should be (:ABSOLUTE :BACK)
+ (aver (string= head "/"))
+ (error 'simple-file-error
+ :pathname pathname
+ :format-control "~@<invalid use of :BACK after :ABSOLUTE.~@:>"))))
+ (%enumerate-files head pathname verify-existence function))))