From 51c6b911ab793c63eed1101953db7c80a393d1c8 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Sun, 28 May 2023 20:12:09 -0700 Subject: [PATCH] Fix #216: enough-namestring with relative pathname fails The current behavior of `enough-namestring` is to fail if the pathname has a relative directory component. But that shouldn't prevent `enough-namestring` from working. In this case it should just return the relative pathname as is. This is how clisp and ecl handle this case. --- src/code/filesys.lisp | 4 ++-- tests/issues.lisp | 9 +++++++++ 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index 518cf83c1..a58625933 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 4f23e3c5f..f9520c40b 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)))))) -- GitLab