0.8.1.27:

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

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 1440777..849d66e 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -54,7 +54,7 @@
    checked for whatever they may have protected."
   (declare (type simple-base-string namestr)
           (type index start end))
    checked for whatever they may have protected."
   (declare (type simple-base-string namestr)
           (type index start end))

-  (let* ((result (make-string (- end start)))
+  (let* ((result (make-string (- end start) :element-type 'base-char))

         (dst 0)
         (quoted nil))
     (do ((src start (1+ src)))
         (dst 0)
         (quoted nil))
     (do ((src start (1+ src)))

@@ -215,107 +215,68 @@
          (setf start (1+ slash))))
       (values absolute (pieces)))))
 
          (setf start (1+ slash))))
       (values absolute (pieces)))))
 

-;;; the thing before a colon in a logical path
-(def!struct (logical-hostname (:make-load-form-fun
-                              (lambda (x)
-                                (values `(make-logical-hostname
-                                          ,(logical-hostname-name x))
-                                        nil)))
-                             (:copier nil)
-                             (:constructor make-logical-hostname (name)))
-  (name (missing-arg) :type simple-string))
-
-(defun maybe-extract-logical-hostname (namestr start end)
-  (declare (type simple-base-string namestr)
-          (type index start end))
-  (let ((quoted nil))
-    (do ((index start (1+ index)))
-       ((= index end)
-        (values nil start))
-      (if quoted
-         (setf quoted nil)
-         (case (schar namestr index)
-           (#\\
-            (setf quoted t))
-           (#\:
-            (return (values (make-logical-hostname
-                             (remove-backslashes namestr start index))
-                            (1+ index)))))))))
-

 (defun parse-unix-namestring (namestr start end)
   (declare (type simple-base-string namestr)
            (type index start end))
   (multiple-value-bind (absolute pieces) (split-at-slashes namestr start end)
 (defun parse-unix-namestring (namestr start end)
   (declare (type simple-base-string namestr)
            (type index start end))
   (multiple-value-bind (absolute pieces) (split-at-slashes namestr start end)

-    (let ((logical-hostname
-          (if absolute
-              nil
-              (let ((first (car pieces)))
-                (multiple-value-bind (logical-hostname new-start)
-                    (maybe-extract-logical-hostname namestr
-                                                    (car first)
-                                                    (cdr first))
-                  (when logical-hostname
-                    (setf absolute t)
-                    (setf (car first) new-start))
-                  logical-hostname)))))
-      (declare (type (or null logical-hostname) logical-hostname))
-      (multiple-value-bind (name type version)
-          (let* ((tail (car (last pieces)))
-                 (tail-start (car tail))
-                 (tail-end (cdr tail)))
-            (unless (= tail-start tail-end)
-              (setf pieces (butlast pieces))
-              (extract-name-type-and-version namestr tail-start tail-end)))
-
-       (when (stringp name)
-         (let ((position (position-if (lambda (char)
-                                        (or (char= char (code-char 0))
-                                            (char= char #\/)))
-                                      name)))
-           (when position
-             (error 'namestring-parse-error
-                    :complaint "can't embed #\\Nul or #\\/ in Unix namestring"
-                    :namestring namestr
-                    :offset position))))
-        
-        ;; Now we have everything we want. So return it.
-        (values nil ; no host for Unix namestrings
-                nil ; no device for Unix namestrings
-                (collect ((dirs))
-                  (when logical-hostname
-                    (dirs logical-hostname))
-                  (dolist (piece pieces)
-                    (let ((piece-start (car piece))
-                          (piece-end (cdr piece)))
-                      (unless (= piece-start piece-end)
-                        (cond ((string= namestr ".."
-                                       :start1 piece-start
-                                        :end1 piece-end)
-                               (dirs :up))
-                              ((string= namestr "**"
-                                       :start1 piece-start
-                                        :end1 piece-end)
-                               (dirs :wild-inferiors))
-                              (t
-                               (dirs (maybe-make-pattern namestr
-                                                         piece-start
-                                                         piece-end)))))))
-                  (cond (absolute
-                         (cons :absolute (dirs)))
-                        ((dirs)
-                         (cons :relative (dirs)))
-                        (t
-                         nil)))
-                name
-                type
-                version)))))
+    (multiple-value-bind (name type version)
+       (let* ((tail (car (last pieces)))
+              (tail-start (car tail))
+              (tail-end (cdr tail)))
+         (unless (= tail-start tail-end)
+           (setf pieces (butlast pieces))
+           (extract-name-type-and-version namestr tail-start tail-end)))
+
+      (when (stringp name)
+       (let ((position (position-if (lambda (char)
+                                      (or (char= char (code-char 0))
+                                          (char= char #\/)))
+                                    name)))
+         (when position
+           (error 'namestring-parse-error
+                  :complaint "can't embed #\\Nul or #\\/ in Unix namestring"
+                  :namestring namestr
+                  :offset position))))
+      ;; Now we have everything we want. So return it.
+      (values nil ; no host for Unix namestrings
+             nil ; no device for Unix namestrings
+             (collect ((dirs))
+               (dolist (piece pieces)
+                 (let ((piece-start (car piece))
+                       (piece-end (cdr piece)))
+                   (unless (= piece-start piece-end)
+                     (cond ((string= namestr ".."
+                                     :start1 piece-start
+                                     :end1 piece-end)
+                            (dirs :up))
+                           ((string= namestr "**"
+                                     :start1 piece-start
+                                     :end1 piece-end)
+                            (dirs :wild-inferiors))
+                           (t
+                            (dirs (maybe-make-pattern namestr
+                                                      piece-start
+                                                      piece-end)))))))
+               (cond (absolute
+                      (cons :absolute (dirs)))
+                     ((dirs)
+                      (cons :relative (dirs)))
+                     (t
+                      nil)))
+             name
+             type
+             version))))

 
 (/show0 "filesys.lisp 300")
 
 (defun unparse-unix-host (pathname)
   (declare (type pathname pathname)
           (ignore pathname))
 
 (/show0 "filesys.lisp 300")
 
 (defun unparse-unix-host (pathname)
   (declare (type pathname pathname)
           (ignore pathname))

-  "Unix")
+  ;; this host designator needs to be recognized as a physical host in
+  ;; PARSE-NAMESTRING. Until sbcl-0.7.3.x, we had "Unix" here, but
+  ;; that's a valid Logical Hostname, so that's a bad choice. -- CSR,
+  ;; 2002-05-09
+  "")

 
 (defun unparse-unix-piece (thing)
   (etypecase thing
 
 (defun unparse-unix-piece (thing)
   (etypecase thing

@@ -368,17 +329,7 @@
     (when directory
       (ecase (pop directory)
        (:absolute
     (when directory
       (ecase (pop directory)
        (:absolute

-        (cond ((logical-hostname-p (car directory))
-               ;; FIXME: The old CMU CL "search list" extension is
-               ;; gone, but the old machinery is still being used
-               ;; clumsily here and elsewhere, to represent anything
-               ;; which belongs before a colon prefix in the ANSI
-               ;; pathname machinery. This should be cleaned up,
-               ;; using simpler machinery with more mnemonic names.
-               (pieces (logical-hostname-name (pop directory)))
-               (pieces ":"))
-              (t
-               (pieces "/"))))
+        (pieces "/"))

        (:relative
         ;; nothing special
         ))
        (:relative
         ;; nothing special
         ))

@@ -558,14 +509,21 @@
                  (when (and res (eql (logand mode sb!unix:s-ifmt)
                                      sb!unix:s-ifdir))
                    (let ((nodes (cons (cons dev ino) nodes)))
                  (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)))
          (etypecase piece
            (simple-string
                      ,@body)))))
     (if tail
        (let ((piece (car tail)))
          (etypecase piece
            (simple-string

-            (let ((head (concatenate 'string head piece)))
+            (let ((head (concatenate 'base-string head piece)))

               (with-directory-node-noted (head)
               (with-directory-node-noted (head)

-                (%enumerate-directories (concatenate 'string head "/")
+                (%enumerate-directories (concatenate 'base-string head "/")

                                         (cdr tail) pathname
                                         verify-existence follow-links
                                         nodes function))))
                                         (cdr tail) pathname
                                         verify-existence follow-links
                                         nodes function))))

@@ -574,7 +532,7 @@
                                     verify-existence follow-links
                                     nodes function)
             (dolist (name (ignore-errors (directory-lispy-filenames head)))
                                     verify-existence follow-links
                                     nodes function)
             (dolist (name (ignore-errors (directory-lispy-filenames head)))

-              (let ((subdir (concatenate 'string head name)))
+              (let ((subdir (concatenate 'base-string head name)))

                 (multiple-value-bind (res dev ino mode)
                     (unix-xstat subdir)
                   (declare (type (or fixnum null) mode))
                 (multiple-value-bind (res dev ino mode)
                     (unix-xstat subdir)
                   (declare (type (or fixnum null) mode))

@@ -585,14 +543,14 @@
                                          (eql (cdr dir) ino))
                                 (return t)))
                       (let ((nodes (cons (cons dev ino) nodes))
                                          (eql (cdr dir) ino))
                                 (return t)))
                       (let ((nodes (cons (cons dev ino) nodes))

-                            (subdir (concatenate 'string subdir "/")))
+                            (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))
                         (%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)))
+                (let ((subdir (concatenate 'base-string head name)))

                   (multiple-value-bind (res dev ino mode)
                       (unix-xstat subdir)
                     (declare (type (or fixnum null) mode))
                   (multiple-value-bind (res dev ino mode)
                       (unix-xstat subdir)
                     (declare (type (or fixnum null) mode))

@@ -600,17 +558,18 @@
                                (eql (logand mode sb!unix:s-ifmt)
                                     sb!unix:s-ifdir))
                       (let ((nodes (cons (cons dev ino) nodes))
                                (eql (logand mode sb!unix:s-ifmt)
                                     sb!unix:s-ifdir))
                       (let ((nodes (cons (cons dev ino) nodes))

-                            (subdir (concatenate 'string subdir "/")))
+                            (subdir (concatenate 'base-string subdir "/")))

                         (%enumerate-directories subdir (rest tail) pathname
                                                 verify-existence follow-links
                                                 nodes function))))))))
          ((member :up)
                         (%enumerate-directories subdir (rest tail) pathname
                                                 verify-existence follow-links
                                                 nodes function))))))))
          ((member :up)

-            (let ((head (concatenate 'string head "..")))
+            (with-directory-node-removed (head)
+            (let ((head (concatenate 'base-string head "..")))

               (with-directory-node-noted (head)
               (with-directory-node-noted (head)

-                (%enumerate-directories (concatenate 'string head "/")
+                (%enumerate-directories (concatenate 'base-string head "/")

                                         (rest tail) pathname
                                         verify-existence follow-links
                                         (rest tail) pathname
                                         verify-existence follow-links

-                                        nodes function))))))
+                                        nodes function)))))))

        (%enumerate-files head pathname verify-existence function))))
 
 ;;; Call FUNCTION on files.
        (%enumerate-files head pathname verify-existence function))))
 
 ;;; Call FUNCTION on files.

@@ -649,19 +608,19 @@
                          (components-match file-type type)
                          (components-match file-version version))
                 (funcall function
                          (components-match file-type type)
                          (components-match file-version version))
                 (funcall function

-                         (concatenate 'string
+                         (concatenate 'base-string

                                       directory
                                       complete-filename))))))
          (t
           (/noshow0 "default case")
                                       directory
                                       complete-filename))))))
          (t
           (/noshow0 "default case")

-          (let ((file (concatenate 'string directory name)))
+          (let ((file (concatenate 'base-string directory name)))

             (/noshow "computed basic FILE")
             (unless (or (null type) (eq type :unspecific))
               (/noshow0 "tweaking FILE for more-or-less-:UNSPECIFIC case")
             (/noshow "computed basic FILE")
             (unless (or (null type) (eq type :unspecific))
               (/noshow0 "tweaking FILE for more-or-less-:UNSPECIFIC case")

-              (setf file (concatenate 'string file "." type)))
-            (unless (member version '(nil :newest :wild))
+              (setf file (concatenate 'base-string file "." type)))
+            (unless (member version '(nil :newest :wild :unspecific))

               (/noshow0 "tweaking FILE for more-or-less-:WILD case")
               (/noshow0 "tweaking FILE for more-or-less-:WILD case")

-              (setf file (concatenate 'string file "."
+              (setf file (concatenate 'base-string file "."

                                       (quick-integer-to-string version))))
             (/noshow0 "finished possibly tweaking FILE")
             (when (or (not verify-existence)
                                       (quick-integer-to-string version))))
             (/noshow0 "finished possibly tweaking FILE")
             (when (or (not verify-existence)

@@ -679,11 +638,11 @@
        ((zerop n) "0")
        ((eql n 1) "1")
        ((minusp n)
        ((zerop n) "0")
        ((eql n 1) "1")
        ((minusp n)

-        (concatenate 'simple-string "-"
-                     (the simple-string (quick-integer-to-string (- n)))))
+        (concatenate 'simple-base-string "-"
+                     (the simple-base-string (quick-integer-to-string (- n)))))

        (t
         (do* ((len (1+ (truncate (integer-length n) 3)))
        (t
         (do* ((len (1+ (truncate (integer-length n) 3)))

-              (res (make-string len))
+              (res (make-string len :element-type 'base-char))

               (i (1- len) (1- i))
               (q n)
               (r 0))
               (i (1- len) (1- i))
               (q n)
               (r 0))

@@ -718,33 +677,21 @@
 
 ;;; Convert PATHNAME into a string that can be used with UNIX system
 ;;; calls, or return NIL if no match is found. Wild-cards are expanded.
 
 ;;; Convert PATHNAME into a string that can be used with UNIX system
 ;;; calls, or return NIL if no match is found. Wild-cards are expanded.

+;;; FIXME this should signal file-error if the pathname is wild, whether
+;;; or not it turns out to have only one match.  Fix post 0.7.2

 (defun unix-namestring (pathname-spec &optional (for-input t))
 (defun unix-namestring (pathname-spec &optional (for-input t))

-  ;; The ordinary rules of converting Lispy paths to Unix paths break
-  ;; down for the current working directory, which Lisp thinks of as
-  ;; "" (more or less, and modulo ANSI's *DEFAULT-PATHNAME-DEFAULTS*,
-  ;; which unfortunately SBCL, as of sbcl-0.6.12.8, basically ignores)
-  ;; and Unix thinks of as ".". Since we're at the interface between
-  ;; Unix system calls and things like ENSURE-DIRECTORIES-EXIST which
-  ;; think the Lisp way, we perform the conversion.
-  ;;
-  ;; (FIXME: The *right* way to deal with this special case is to
-  ;; merge PATHNAME-SPEC with *DEFAULT-PATHNAME-DEFAULTS* here, after
-  ;; which it's not a relative pathname any more so the special case
-  ;; is no longer an issue. But until *DEFAULT-PATHNAME-DEFAULTS*
-  ;; works, we use this hack.)
-  (if (empty-relative-pathname-spec-p pathname-spec)
-      "."
-      ;; Otherwise, the ordinary rules apply.
-      (let* ((namestring (physicalize-pathname (pathname pathname-spec)))
-            (matches nil)) ; an accumulator for actual matches
-       (!enumerate-matches (match namestring nil :verify-existence for-input)
-          (push match matches))
-       (case (length matches)
-         (0 nil)
-         (1 (first matches))
-         (t (error 'simple-file-error
-                   :format-control "~S is ambiguous:~{~%  ~A~}"
-                   :format-arguments (list pathname-spec matches)))))))
+  (let* ((namestring (physicalize-pathname (merge-pathnames pathname-spec)))
+        (matches nil)) ; an accumulator for actual matches
+    (when (wild-pathname-p namestring)
+      (error 'simple-file-error
+            :pathname namestring
+            :format-control "bad place for a wild pathname"))
+    (!enumerate-matches (match namestring nil :verify-existence for-input)
+                       (push match matches))
+    (case (length matches)
+      (0 nil)
+      (1 (first matches))
+      (t (bug "!ENUMERATE-MATCHES returned more than one match on a non-wild pathname")))))

 \f
 ;;;; TRUENAME and PROBE-FILE
 
 \f
 ;;;; TRUENAME and PROBE-FILE
 

@@ -758,27 +705,19 @@
 
   Under Unix, the TRUENAME of a broken symlink is considered to be
   the name of the broken symlink itself."
 
   Under Unix, the TRUENAME of a broken symlink is considered to be
   the name of the broken symlink itself."

-  (if (wild-pathname-p pathname)
+  (let ((result (probe-file pathname)))
+    (unless result

       (error 'simple-file-error
       (error 'simple-file-error

-            :format-control "can't use a wild pathname here"
-            :pathname pathname)
-      (let ((result (probe-file pathname)))
-       (unless result
-         (error 'simple-file-error
-                :pathname pathname
-                :format-control "The file ~S does not exist."
-                :format-arguments (list (namestring pathname))))
-       result)))
+            :pathname pathname
+            :format-control "The file ~S does not exist."
+            :format-arguments (list (namestring pathname))))
+    result))

 
 ;;; If PATHNAME exists, return its truename, otherwise NIL.
 (defun probe-file (pathname)
   #!+sb-doc
   "Return a pathname which is the truename of the file if it exists, or NIL
   otherwise. An error of type FILE-ERROR is signaled if pathname is wild."
 
 ;;; If PATHNAME exists, return its truename, otherwise NIL.
 (defun probe-file (pathname)
   #!+sb-doc
   "Return a pathname which is the truename of the file if it exists, or NIL
   otherwise. An error of type FILE-ERROR is signaled if pathname is wild."

-  (when (wild-pathname-p pathname)
-    (error 'simple-file-error
-          :pathname pathname
-          :format-control "can't use a wild pathname here"))

   (let* ((defaulted-pathname (merge-pathnames
                              pathname
                              (sane-default-pathname-defaults)))
   (let* ((defaulted-pathname (merge-pathnames
                              pathname
                              (sane-default-pathname-defaults)))

@@ -786,8 +725,11 @@
     (when (and namestring (sb!unix:unix-file-kind namestring t))
       (let ((trueishname (sb!unix:unix-resolve-links namestring)))
        (when trueishname
     (when (and namestring (sb!unix:unix-file-kind namestring t))
       (let ((trueishname (sb!unix:unix-resolve-links namestring)))
        (when trueishname

-         (let ((*ignore-wildcards* t))
-           (pathname (sb!unix:unix-simplify-pathname trueishname))))))))
+         (let* ((*ignore-wildcards* t)
+                (name (sb!unix:unix-simplify-pathname trueishname))) 
+           (if (eq (sb!unix:unix-file-kind name) :directory)
+               (pathname (concatenate 'string name "/"))
+               (pathname name))))))))

 \f
 ;;;; miscellaneous other operations
 
 \f
 ;;;; miscellaneous other operations
 

@@ -835,63 +777,39 @@
   t)
 \f
 ;;; (This is an ANSI Common Lisp function.) 
   t)
 \f
 ;;; (This is an ANSI Common Lisp function.) 

-;;;
-;;; This is obtained from the logical name \"home:\", which is set
-;;; up for us at initialization time.

 (defun user-homedir-pathname (&optional host)
   "Return the home directory of the user as a pathname."
   (declare (ignore host))
 (defun user-homedir-pathname (&optional host)
   "Return the home directory of the user as a pathname."
   (declare (ignore host))

-  ;; Note: CMU CL did #P"home:" here instead of using a call to
-  ;; PATHNAME. Delaying construction of the pathname until we're
-  ;; running in a target Lisp lets us avoid figuring out how to dump
-  ;; cross-compilation host Lisp PATHNAME objects into a target Lisp
-  ;; object file. It also might have a small positive effect on
-  ;; efficiency, in that we don't allocate a PATHNAME we don't need,
-  ;; but it it could also have a larger negative effect. Hopefully
-  ;; it'll be OK. -- WHN 19990714
-  (pathname "home:"))
+  (pathname (sb!unix:uid-homedir (sb!unix:unix-getuid))))

 
 (defun file-write-date (file)
   #!+sb-doc
   "Return file's creation date, or NIL if it doesn't exist.
  An error of type file-error is signaled if file is a wild pathname"
 
 (defun file-write-date (file)
   #!+sb-doc
   "Return file's creation date, or NIL if it doesn't exist.
  An error of type file-error is signaled if file is a wild pathname"

-  (if (wild-pathname-p file)
-      ;; FIXME: This idiom appears many times in this file. Perhaps it
-      ;; should turn into (CANNOT-BE-WILD-PATHNAME FILE). (C-B-W-P
-      ;; should be a macro, not a function, so that the error message
-      ;; is reported as coming from e.g. FILE-WRITE-DATE instead of
-      ;; from CANNOT-BE-WILD-PATHNAME itself.)
-      (error 'simple-file-error
-            :pathname file
-            :format-control "bad place for a wild pathname")
-      (let ((name (unix-namestring file t)))
-       (when name
-         (multiple-value-bind
-             (res dev ino mode nlink uid gid rdev size atime mtime)
-             (sb!unix:unix-stat name)
-           (declare (ignore dev ino mode nlink uid gid rdev size atime))
-           (when res
-             (+ unix-to-universal-time mtime)))))))
+  (let ((name (unix-namestring file t)))
+    (when name
+      (multiple-value-bind
+           (res dev ino mode nlink uid gid rdev size atime mtime)
+         (sb!unix:unix-stat name)
+       (declare (ignore dev ino mode nlink uid gid rdev size atime))
+       (when res
+         (+ unix-to-universal-time mtime))))))

 
 (defun file-author (file)
   #!+sb-doc
   "Return the file author as a string, or NIL if the author cannot be
  determined. Signal an error of type FILE-ERROR if FILE doesn't exist,
  or FILE is a wild pathname."
 
 (defun file-author (file)
   #!+sb-doc
   "Return the file author as a string, or NIL if the author cannot be
  determined. Signal an error of type FILE-ERROR if FILE doesn't exist,
  or FILE is a wild pathname."

-  (if (wild-pathname-p file)
+  (let ((name (unix-namestring (pathname file) t)))
+    (unless name

       (error 'simple-file-error
             :pathname file
       (error 'simple-file-error
             :pathname file

-            "bad place for a wild pathname")
-      (let ((name (unix-namestring (pathname file) t)))
-       (unless name
-         (error 'simple-file-error
-                :pathname file
-                :format-control "~S doesn't exist."
-                :format-arguments (list file)))
-       (multiple-value-bind (winp dev ino mode nlink uid)
-           (sb!unix:unix-stat name)
-         (declare (ignore dev ino mode nlink))
-         (and winp (sb!unix:uid-username uid))))))
+            :format-control "~S doesn't exist."
+            :format-arguments (list file)))
+    (multiple-value-bind (winp dev ino mode nlink uid)
+       (sb!unix:unix-stat name)
+      (declare (ignore dev ino mode nlink))
+      (and winp (sb!unix:uid-username uid)))))

 \f
 ;;;; DIRECTORY
 
 \f
 ;;;; DIRECTORY
 

@@ -905,21 +823,14 @@
    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,
    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))
        (truenames (make-hash-table :test #'equal))

-       ;; FIXME: not really right, as per bug 139
-        (merged-pathname (merge-pathnames pathname
-                                         (make-pathname :name :wild
-                                                        :type :wild
-                                                        :version :wild))))
+        (merged-pathname (merge-pathnames pathname)))

     (!enumerate-matches (match merged-pathname)
     (!enumerate-matches (match merged-pathname)

-      (let ((*ignore-wildcards* t)
-            (truename (truename (if (eq (sb!unix:unix-file-kind match)
-                                       :directory)
-                                    (concatenate 'string match "/")
-                                    match))))
+      (let* ((*ignore-wildcards* t)
+            (truename (truename match)))

         (setf (gethash (namestring truename) truenames)
              truename)))
     (mapcar #'cdr
         (setf (gethash (namestring truename) truenames)
              truename)))
     (mapcar #'cdr