Raymond Toy pushed to branch master at cmucl / cmucl Commits: 648c1127 by Raymond Toy at 2023-05-31T03:55:52+00:00 Fix #216: enough-namestring with relative pathname fails - - - - - 660ab4c5 by Raymond Toy at 2023-05-31T03:56:07+00:00 Merge branch 'issue-216-enough-namestring-relative-dir' into 'master' Fix #216: enough-namestring with relative pathname fails Closes #216 See merge request cmucl/cmucl!152 - - - - - 2 changed files: - src/code/filesys.lisp - tests/issues.lisp Changes: ===================================== 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 ===================================== 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)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/dcb8124fa472a81202ddd82... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/dcb8124fa472a81202ddd82... You're receiving this email because of your account on gitlab.common-lisp.net.