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...