From 5a7debb7fa6c532ffc4ff41f61352336d9a93697 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 28 May 2006 12:24:04 +0000 Subject: [PATCH] 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 --- NEWS | 3 +++ src/code/target-pathname.lisp | 2 +- tests/pathnames.impure.lisp | 8 +++++++- version.lisp-expr | 2 +- 4 files changed, 12 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index 7994058..950cd1e 100644 --- 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 --- 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 --- 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:**;*\""))) - + +;;; 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"))))) + ;;;; success diff --git a/version.lisp-expr b/version.lisp-expr index 7e8523a..9c6db8a 100644 --- 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" -- 1.7.10.4