0.pre7.122:

[sbcl.git] / src / code / filesys.lisp

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 214e585..ca9a19f 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -531,15 +531,15 @@
   (let ((directory (pathname-directory pathname)))
     (/noshow0 "computed DIRECTORY")
     (if directory
-       (ecase (car directory)
+       (ecase (first directory)
          (:absolute
           (/noshow0 "absolute directory")
-          (%enumerate-directories "/" (cdr directory) pathname
+          (%enumerate-directories "/" (rest directory) pathname
                                   verify-existence follow-links
                                   nil function))
          (:relative
           (/noshow0 "relative directory")
-          (%enumerate-directories "" (cdr directory) pathname
+          (%enumerate-directories "" (rest directory) pathname
                                   verify-existence follow-links
                                   nil function)))
        (%enumerate-files "" pathname verify-existence function))))
@@ -558,6 +558,13 @@
                  (when (and res (eql (logand mode sb!unix:s-ifmt)
                                      sb!unix:s-ifdir))
                    (let ((nodes (cons (cons dev ino) nodes)))
+                     ,@body))))
+            (with-directory-node-removed ((head) &body body)
+              `(multiple-value-bind (res dev ino mode)
+                   (unix-xstat ,head)
+                 (when (and res (eql (logand mode sb!unix:s-ifmt)
+                                     sb!unix:s-ifdir))
+                   (let ((nodes (remove (cons dev ino) nodes :test #'equal)))
                      ,@body)))))
     (if tail
        (let ((piece (car tail)))
@@ -605,12 +612,13 @@
                                                 verify-existence follow-links
                                                 nodes function))))))))
          ((member :up)
+            (with-directory-node-removed (head)
             (let ((head (concatenate 'string head "..")))
               (with-directory-node-noted (head)
                 (%enumerate-directories (concatenate 'string head "/")
                                         (rest tail) pathname
                                         verify-existence follow-links
-                                        nodes function))))))
+                                        nodes function)))))))
        (%enumerate-files head pathname verify-existence function))))
 
 ;;; Call FUNCTION on files.
@@ -905,14 +913,12 @@
    means this function can sometimes return files which don't have the same
    directory as PATHNAME."
   (let (;; We create one entry in this hash table for each truename,
-       ;; as an asymptotically fast way of removing duplicates (which
-       ;; can arise when e.g. multiple symlinks map to the same
-       ;; truename).
+       ;; as an asymptotically efficient way of removing duplicates
+       ;; (which can arise when e.g. multiple symlinks map to the
+       ;; same truename).
        (truenames (make-hash-table :test #'equal))
         (merged-pathname (merge-pathnames pathname
-                                         (make-pathname :name :wild
-                                                        :type :wild
-                                                        :version :wild))))
+                                         *default-pathname-defaults*)))
     (!enumerate-matches (match merged-pathname)
       (let ((*ignore-wildcards* t)
             (truename (truename (if (eq (sb!unix:unix-file-kind match)