diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index 518cf83c18b383ccc97f57d04188afb64c532284..a58625933ed05513ae01dc5ae00daa34b6388b16 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -610,8 +610,8 @@ ;; We are an absolute pathname, so we can just use it. pathname-directory) (t - ;; We are a relative directory. So we lose. - (lose))))) + ;; We are a relative directory, so just return it as is. + pathname-directory)))) (strings (unparse-unix-directory-list result-dir))) (let* ((pathname-version (%pathname-version pathname)) (version-needed (and pathname-version diff --git a/tests/issues.lisp b/tests/issues.lisp index 4f23e3c5fd761c1f403751cdc72aeadce3615f8d..f9520c40b5d459cbf275a70c906c575b3e192587 100644 --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -977,3 +977,12 @@ (assert-true (equal (make-pathname :version :newest) (make-pathname :version :unspecific))) ) + +(define-test issue.216.enough-namestring-relative-dir + (:tag :issues) + (let ((pathname #p"foo/bar.lisp")) + (dolist (defaults '(#p"/tmp/zot/" #p"/tmp/zot/foo/")) + (let ((enough (enough-namestring pathname defaults))) + ;; This is the condition from the CLHS entry for enough-namestring + (assert-equal (merge-pathnames enough defaults) + (merge-pathnames (parse-namestring pathname nil defaults) defaults))))))