From 32b945abf23928e432d5c01d51c48806bd947876 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Sat, 17 Sep 2016 11:44:09 -0400 Subject: [PATCH] UIOP: Fix long-standing pathname issue on CLISP Make ENSURE-DIRECTORY-PATHNAME and TRUENAME* more robust in case MAKE-PATHNAME throws an error when trying to synthetize a pathname with components that the implementation considers invalid. Uncomment the proper definition of LISP-IMPLEMENTATION-DIRECTORY on CLISP, which now doesn't break asdf-pathname-test anymore. --- uiop/filesystem.lisp | 4 ++-- uiop/pathname.lisp | 12 +++++++----- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp index 7f1e199c2..a04334a9a 100644 --- a/uiop/filesystem.lisp +++ b/uiop/filesystem.lisp @@ -71,7 +71,7 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" (or (ignore-errors (truename p)) ;; this is here because trying to find the truename of a directory pathname WITHOUT supplying ;; a trailing directory separator, causes an error on some lisps. - #+(or clisp gcl) (if-let (d (ensure-directory-pathname p)) (ignore-errors (truename d))))))) + #+(or clisp gcl) (if-let (d (ensure-directory-pathname p nil)) (ignore-errors (truename d))))))) (defun safe-file-write-date (pathname) "Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error." @@ -546,7 +546,7 @@ NILs." (let ((dir #+abcl extensions:*lisp-home* #+(or allegro clasp ecl mkcl) #p"SYS:" - ;;#+clisp custom:*lib-directory* ; causes failure in asdf-pathname-test(!) + #+clisp custom:*lib-directory* #+clozure #p"ccl:" #+cmucl (ignore-errors (pathname-parent-directory-pathname (truename #p"modules:"))) #+gcl system::*system-directory* diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp index 2d618a58e..15af1fb4b 100644 --- a/uiop/pathname.lisp +++ b/uiop/pathname.lisp @@ -326,11 +326,13 @@ actually-existing directory." ((directory-pathname-p pathspec) pathspec) (t - (make-pathname :directory (append (or (normalize-pathname-directory-component - (pathname-directory pathspec)) - (list :relative)) - (list (file-namestring pathspec))) - :name nil :type nil :version nil :defaults pathspec))))) + (handler-case + (make-pathname :directory (append (or (normalize-pathname-directory-component + (pathname-directory pathspec)) + (list :relative)) + (list (file-namestring pathspec))) + :name nil :type nil :version nil :defaults pathspec) + (error (c) (call-function on-error (compatfmt "~@<error while trying to create a directory pathname for ~S: ~A~@:>") pathspec c))))))) ;;; Parsing filenames -- GitLab