Skip to content
Snippets Groups Projects
Commit dc506a1d authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

More pathname tweaks, found thanks to LispWorks, CMUCL.

parent 2a48eb41
No related branches found
No related tags found
No related merge requests found
......@@ -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)
......
......@@ -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)))))))))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment