Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv19938
Modified Files: osicat.lisp test-osicat.lisp Log Message: * Fixed bug where foo.bar/ directories become foo/bar/.
Date: Wed Apr 21 18:34:36 2004 Author: jsquires
Index: src/osicat.lisp diff -u src/osicat.lisp:1.17 src/osicat.lisp:1.18 --- src/osicat.lisp:1.17 Mon Mar 8 01:41:32 2004 +++ src/osicat.lisp Wed Apr 21 18:34:35 2004 @@ -110,7 +110,9 @@ (let ((type (pathname-type path))) (and (stringp type) type))) (fixeddir (path) - (let ((dir (pathname-directory path))) + (let ((dir (pathname-directory (concatenate 'string + (namestring path) + "/")))) (if (member (car dir) '(:absolute :relative)) dir (cons :relative dir))))) @@ -118,12 +120,7 @@ (with-cstring (cfile (namestring path)) (let ((abspath (if (eq :directory (c-file-kind cfile t)) (make-pathname :name nil :type nil - :directory - (append (fixeddir path) - (remove-if - #'null - (list (fixedname path) - (fixedtype path)))) + :directory (fixeddir path) :defaults path) path))) (if absolute
Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.5 src/test-osicat.lisp:1.6 --- src/test-osicat.lisp:1.5 Sun Feb 29 18:52:23 2004 +++ src/test-osicat.lisp Wed Apr 21 18:34:35 2004 @@ -50,14 +50,16 @@ t)
(deftest environment.1 - (cdr (assoc "HOME" (environment) :test #'equal)) + (namestring (osicat::normpath (cdr (assoc "HOME" (environment) + :test #'equal)) + t)) #.(namestring (user-homedir-pathname)))
(deftest environment.2 (unwind-protect (progn (setf (environment-variable 'test-variable) "TEST-VALUE") - (assoc "TEST-VARIABLE" environment :test 'equal)) + (assoc "TEST-VARIABLE" (environment) :test #'equal)) (makunbound-environment-variable 'test-variable)) ("TEST-VARIABLE" . "TEST-VALUE"))
@@ -202,3 +204,17 @@ (delete-file file) (delete-directory dir))) (#.(pathname-directory (merge-pathnames "mapdir-test/" *test-dir*)))) + +(deftest mapdir.4 + ;; Test that directories of form foo.bar/ don't become foo/bar/. + (let* ((dir (ensure-directories-exist + (merge-pathnames "mapdir-test.type/" *test-dir*))) + (file (ensure-file "foo.bar" dir))) + (unwind-protect + (let ((*default-directory-defaults* (truename "/tmp/"))) + (mapdir (lambda (x) + (pathname-directory (merge-pathnames x))) + dir)) + (delete-file file) + (delete-directory dir))) + (#.(pathname-directory (merge-pathnames "mapdir-test.type/" *test-dir*))))