From: Christophe R. <cr...@us...> - 2006-05-28 12:24:20
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv30549/tests Modified Files: pathnames.impure.lisp Log Message: 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 Index: pathnames.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/pathnames.impure.lisp,v retrieving revision 1.29 retrieving revision 1.30 diff -u -d -r1.29 -r1.30 --- pathnames.impure.lisp 28 May 2006 10:22:22 -0000 1.29 +++ pathnames.impure.lisp 28 May 2006 12:24:04 -0000 1.30 @@ -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 |