Loading test/test-utilities.script +5 −6 Original line number Diff line number Diff line Loading @@ -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")) (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) Loading @@ -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) Loading uiop/pathname.lisp +5 −4 Original line number Diff line number Diff line Loading @@ -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)) Loading Loading @@ -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 Loading @@ -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))))))))))) Loading Loading
test/test-utilities.script +5 −6 Original line number Diff line number Diff line Loading @@ -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")) (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) Loading @@ -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) Loading
uiop/pathname.lisp +5 −4 Original line number Diff line number Diff line Loading @@ -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)) Loading Loading @@ -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 Loading @@ -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))))))))))) Loading