0.9.13.5:

	Fix for bug reported by James Y Knight sbcl-devel 2006-05-17
	"merge-pathnames bug"
	... don't let :back scribble over :relative

diff --git a/NEWS b/NEWS
index 7994058..950cd1e 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,9 @@ changes in sbcl-0.9.14 relative to sbcl-0.9.13:
     the other three SLOT-VALUEish functions, but not for the setter).
   * bug fix: unparsing logical pathnames with :NAME :WILD :TYPE NIL
     failed with a type error.  (reported by Pascal Bourguignon)
+  * bug fix: merging pathnames against defaults with :DIRECTORY
+    starting with '(:RELATIVE :BACK) should preserve the :BACK.
+    (reported by James Y Knight)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** MISC.641: LET-conversion were not supposed to work in late
        compilation stages.

diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index d8dd557..bff90db 100644 (file)
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -459,7 +459,7 @@ the operating system native pathname conventions."
                  (if (and (eq dir :back)
                           results
                           (not (member (car results)
-                                       '(:back :wild-inferiors))))
+                                       '(:back :wild-inferiors :relative :absolute))))
                      (pop results)
                      (push dir results))))
           (dolist (dir (maybe-diddle-case dir2 diddle-case))

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 891c589..86bf11b 100644 (file)
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -369,5 +369,11 @@
                                :name :wild :type nil)))
   (assert (string= (namestring pathname) "SYS:**;*"))
   (assert (string= (write-to-string pathname :readably t) "#P\"SYS:**;*\"")))
-
+\f
+;;; reported by James Y Knight on sbcl-devel 2006-05-17
+(let ((p1 (make-pathname :directory '(:relative "bar")))
+      (p2 (make-pathname :directory '(:relative :back "foo"))))
+  (assert (equal (merge-pathnames p1 p2)
+                 (make-pathname :directory '(:relative :back "foo" "bar")))))
+\f
 ;;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index 7e8523a..9c6db8a 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.13.4"
+"0.9.13.5"