follow-links nodes function
&aux (host (pathname-host pathname)))
(declare (simple-string head))
+ #!+win32
+ (setf follow-links nil)
(macrolet ((unix-xstat (name)
`(if follow-links
(sb!unix:unix-stat ,name)
sb!unix:s-ifdir))
(unless (dolist (dir nodes nil)
(when (and (eql (car dir) dev)
+ #!+win32 ;; KLUDGE
+ (not (zerop ino))
(eql (cdr dir) ino))
(return t)))
(let ((nodes (cons (cons dev ino) nodes))
(defun truename (pathname)
#!+sb-doc
"Return the pathname for the actual file described by PATHNAME.
- An error of type FILE-ERROR is signalled if no such file exists,
- or the pathname is wild.
+An error of type FILE-ERROR is signalled if no such file exists, or the
+pathname is wild.
- 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."
(let ((result (probe-file pathname)))
(unless result
(error 'simple-file-error
(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."
+otherwise. An error of type FILE-ERROR is signaled if pathname is wild."
(let* ((defaulted-pathname (merge-pathnames
pathname
(sane-default-pathname-defaults)))
(let ((trueishname (sb!unix:unix-resolve-links namestring)))
(when trueishname
(let* ((*ignore-wildcards* t)
- (name (sb!unix:unix-simplify-pathname trueishname)))
+ (name (simplify-namestring
+ trueishname
+ (pathname-host defaulted-pathname))))
(if (eq (sb!unix:unix-file-kind name) :directory)
;; FIXME: this might work, but it's ugly.
(pathname (concatenate 'string name "/"))
(defun sbcl-homedir-pathname ()
(let ((sbcl-home (posix-getenv "SBCL_HOME")))
;; SBCL_HOME isn't set for :EXECUTABLE T embedded cores
- (when sbcl-home
+ (when (and sbcl-home (not (string= sbcl-home "")))
(parse-native-namestring
(ensure-trailing-slash sbcl-home)))))
is returned; otherwise obtains the home directory from the operating
system."
(declare (ignore host))
- (parse-native-namestring
- (ensure-trailing-slash
- (if (posix-getenv "HOME")
- (posix-getenv "HOME")
- #!-win32
- (sb!unix:uid-homedir (sb!unix:unix-getuid))
- #!+win32
- ;; Needs to bypass PARSE-NATIVE-NAMESTRING & ENSURE-TRAILING-SLASH
- (return-from user-homedir-pathname
- (sb!win32::get-folder-pathname sb!win32::csidl_profile))))))
+ (let ((env-home (posix-getenv "HOME")))
+ (parse-native-namestring
+ (ensure-trailing-slash
+ (if (and env-home (not (string= env-home "")))
+ env-home
+ #!-win32
+ (sb!unix:uid-homedir (sb!unix:unix-getuid))
+ #!+win32
+ ;; Needs to bypass PARSE-NATIVE-NAMESTRING & ENSURE-TRAILING-SLASH
+ (return-from user-homedir-pathname
+ (sb!win32::get-folder-pathname sb!win32::csidl_profile)))))))
(defun file-write-date (file)
#!+sb-doc
;; grounds that the implementation should have repeatable
;; behavior when possible.
(sort (loop for name being each hash-key in truenames
- using (hash-value truename)
- collect (cons name truename))
+ using (hash-value truename)
+ collect (cons name truename))
#'string<
:key #'car))))
\f