Dear Juanjo,
thanks for your input and sorry for not looking at the details of your
patch earlier.
I don't see what probe-file does that's different from (ignore-errors
(truename ...)), but OK for the sake of performance I can see it being
done. Is CLISP the only one to error when probe-file'ing a directory?
Can/should we always test for the wildcardness of the pathname?
Can you test/review the following patch based on yours? I intend to
make it into ASDF 2.112.
[ François-René ÐVB Rideau | Reflection&Cybernethics | http://fare.tunes.org ]
If you make people think they're thinking, they'll love you;
but if you really make them think, they'll hate you. — Don Marquis
diff --git a/asdf.lisp b/asdf.lisp
index 34bfa10..967681b 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -750,6 +750,13 @@ actually-existing directory."
:directory '(:absolute)
:name nil :type nil :version nil))
+(defun probe-file* (p)
+ "when given a pathname P, probes the filesystem for a file or directory
+with given pathname and if it exists return its truename."
+ (and (pathnamep p) (not (wild-pathname-p p))
+ #+clisp (ignore-errors (truename p))
+ #-clisp (probe-file p)))
+
(defun truenamize (p)
"Resolve as much of a pathname as possible"
(block nil
@@ -757,10 +764,11 @@ actually-existing directory."
(let* ((p (merge-pathnames* p))
(directory (pathname-directory p)))
(when (typep p 'logical-pathname) (return p))
- (ignore-errors (return (truename p)))
+ (let ((found (probe-file* p)))
+ (when found (return found)))
#-sbcl (when (stringp directory) (return p))
(when (not (eq :absolute (car directory))) (return p))
- (let ((sofar (ignore-errors (truename (pathname-root p)))))
+ (let ((sofar (probe-file* (pathname-root p))))
(unless sofar (return p))
(flet ((solution (directories)
(merge-pathnames*
@@ -772,11 +780,10 @@ actually-existing directory."
sofar)))
(loop :for component :in (cdr directory)
:for rest :on (cdr directory)
- :for more = (ignore-errors
- (truename
- (merge-pathnames*
- (make-pathname :directory `(:relative ,component))
- sofar))) :do
+ :for more = (probe-file*
+ (merge-pathnames*
+ (make-pathname :directory `(:relative ,component))
+ sofar)) :do
(if more
(setf sofar more)
(return (solution rest)))
@@ -2502,9 +2509,9 @@ located."
(defun try-directory-subpath (x sub &key type)
(let* ((p (and x (ensure-directory-pathname x)))
- (tp (and p (ignore-errors (truename p))))
+ (tp (and p (probe-file* p)))
(sp (and tp (merge-pathnames* (merge-component-name-type sub :type type) p)))
- (ts (and sp (ignore-errors (truename sp)))))
+ (ts (and sp (probe-file* sp))))
(and ts (values sp ts))))
(defun user-configuration-directories ()
(remove-if
@@ -2531,8 +2538,7 @@ located."
(list #p"/etc/common-lisp/"))))
(defun in-first-directory (dirs x)
(loop :for dir :in dirs
- :thereis (and dir (ignore-errors
- (truename (merge-pathnames* x (ensure-directory-pathname dir)))))))
+ :thereis (and dir (probe-file* (merge-pathnames* x (ensure-directory-pathname dir))))))
(defun in-user-configuration-directory (x)
(in-first-directory (user-configuration-directories) x))
(defun in-system-configuration-directory (x)
_______________________________________________
asdf-devel mailing list
[email protected]
http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel
