From: Richard M K. <kr...@us...> - 2008-01-01 01:01:12
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv26375/tests Modified Files: filesys.pure.lisp Log Message: 1.0.13.5: Fix bugs in USER-HOMEDIR-PATHNAME, SBCL-HOMEDIR-PATHNAME * Both these functions parsed filenames returned by system calls implicitly using to the syntax of *DEFAULT-PATHNAME-DEFAULTS*, and so would lose when *D-P-D* was a logical pathname host. So have them parse filenames using explicit physical pathname hosts. * Tests for same. Index: filesys.pure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/filesys.pure.lisp,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- filesys.pure.lisp 28 Oct 2006 09:57:01 -0000 1.13 +++ filesys.pure.lisp 1 Jan 2008 01:01:02 -0000 1.14 @@ -141,3 +141,17 @@ for pathname = (native-pathname native-namestring) for tricky-nnn = (native-namestring pathname) do (assert (string= tricky-nnn native-namestring))))) + +;;; USER-HOMEDIR-PATHNAME and the extension SBCL-HOMEDIR-PATHNAME both +;;; used to call PARSE-NATIVE-NAMESTRING without supplying a HOST +;;; argument, and so would lose when *DEFAULT-PATHNAME-DEFAULTS* was a +;;; logical pathname. +(with-test (:name :user-homedir-pathname-robustness) + (let ((*default-pathname-defaults* (pathname "SYS:"))) + (assert (not (typep (user-homedir-pathname) + 'logical-pathname))))) + +(with-test (:name :sbcl-homedir-pathname-robustness) + (let ((*default-pathname-defaults* (pathname "SYS:"))) + (assert (not (typep (sb-impl::sbcl-homedir-pathname) + 'logical-pathname))))) |