diff --git a/test/test-utilities.script b/test/test-utilities.script index 49708b0c55636cb035f370c7c3dc6eb69249079d..b67336f9e65945f75c111c8f478b9b7ab0eaaa78 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -3,13 +3,10 @@ (assert (every #'directory-pathname-p (list - (make-pathname* :name nil :type "" :directory '(:absolute "tmp")) - (make-pathname* :name "" :directory '(:absolute "tmp")) - (make-pathname* :type "" :directory '(:absolute "tmp")) -;; CLHS 19.2.2.2.3 says we can't portably specify :unspecific here, -;; and some implementations will enforce it. + (make-pathname* :name nil :type nil :directory '(:absolute "tmp")) + ;; CLHS 19.2.2.2.3 says we can't portably specify :unspecific here, + ;; and some implementations will enforce it. (make-pathname* :type *unspecific-pathname-type* :directory '(:absolute "tmp")) - (make-pathname* :name *unspecific-pathname-type* :directory '(:absolute "tmp")) (make-pathname* :name *unspecific-pathname-type* :directory '(:absolute "tmp"))))) (assert (every (complement #'directory-pathname-p) @@ -17,6 +14,8 @@ (make-pathname* :name "foo" :type nil :directory '(:absolute "tmp")) (make-pathname* :name nil :type "bar" :directory '(:absolute "tmp"))))) ;; These are funky and non portable, omit from tests: +;; (make-pathname* :name "" :type nil :directory '(:absolute "tmp")) +;; (make-pathname* :name nil :type "" :directory '(:absolute "tmp")) ;; (make-pathname* :name "." :type nil :directory '(:absolute "tmp")) ;; (make-pathname* :name "." :type "" :directory '(:absolute "tmp")) (macrolet ((ts (x y) diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp index 87440fc75473c7fa3f05f425153a8e012b2a5d18..edd157717e73ee2e686752ebf7539c346db18982 100644 --- a/uiop/pathname.lisp +++ b/uiop/pathname.lisp @@ -307,7 +307,7 @@ actually-existing directory." ;; ill-formed. [2014/02/10:rpg] (let ((pathname (pathname pathname))) (flet ((check-one (x) - (member x '(nil :unspecific "") :test 'equal))) + (member x '(nil :unspecific) :test 'equal))) (and (not (wild-pathname-p pathname)) (check-one (pathname-name pathname)) (check-one (pathname-type pathname)) @@ -483,13 +483,14 @@ or if it is a PATHNAME but some of its components are not recognized." ((or null string) pathname) (pathname (with-output-to-string (s) - (flet ((err () (error "Not a valid unix-namestring ~S" pathname))) + (flet ((err () #+lispworks (describe pathname) (error "Not a valid unix-namestring ~S" pathname))) (let* ((dir (normalize-pathname-directory-component (pathname-directory pathname))) (name (pathname-name pathname)) + (name (and (not (eq name :unspecific)) name)) (type (pathname-type pathname)) (type (and (not (eq type :unspecific)) type))) (cond - ((eq dir ())) + ((member dir '(nil :unspecific))) ((eq dir '(:relative)) (princ "./" s)) ((consp dir) (destructuring-bind (relabs &rest dirs) dir @@ -505,7 +506,7 @@ or if it is a PATHNAME but some of its components are not recognized." (t (err))) (cond (name - (or (and (stringp name) (or (null type) (stringp type))) (err)) + (unless (and (stringp name) (or (null type) (stringp type))) (err)) (format s "~A~@[.~A~]" name type)) (t (or (null type) (err)))))))))))