Loading src/code/filesys.lisp +5 −1 Original line number Diff line number Diff line Loading @@ -950,7 +950,11 @@ File after it was renamed." (let* ((original (truename file)) (original-namestring (unix-namestring original t)) (new-name (merge-pathnames new-name file)) ;; First, merge NEW-FILE-NAME with *DEFAULT-PATHNAME-DEFAULTS* to ;; fill in the missing components and then merge again with ;; the FILE to get any missing components from FILE. (new-name (merge-pathnames (merge-pathnames new-name) file)) (new-namestring (unix-namestring new-name nil))) (unless new-namestring (error 'simple-file-error Loading tests/issues.lisp +66 −0 Original line number Diff line number Diff line Loading @@ -579,3 +579,69 @@ with user-info = (unix:unix-getpwuid uid) while user-info finally (assert-false user-info))) (define-test issue.132.1 (:tag :issues) ;; From a message on cmucl-imp 2008/06/01. If "d1" is a directory, ;; (rename "d1" "d2") should rename the directory "d1" to "d2". ;; Previously that produced an error trying to rename "d1" to ;; "d1/d2". ;; ;; Create the test directory (that is a subdirectory of "dir"). (assert-true (ensure-directories-exist "dir/orig-dir/")) (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory)))) (multiple-value-bind (defaulted-new-name old-truename new-truename) ;; Rename "dir/orig-dir" to "orig/new-dir". (rename-file "orig-dir/" "new-dir") (let ((orig (merge-pathnames (make-pathname :directory '(:relative "orig-dir")))) (new (merge-pathnames (make-pathname :directory '(:relative "new-dir"))))) ;; Ensure that the rename worked and that the returned values ;; have the expected values. (assert-true defaulted-new-name) (assert-equalp old-truename orig) (assert-equalp new-truename new))))) (define-test issue.132.2 (:tag :issues) (assert-true (ensure-directories-exist "dir/orig.dir/")) (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory)))) (multiple-value-bind (defaulted-new-name old-truename new-truename) ;; Rename "dir/orig.dir" to "orig/new-dir". Since the ;; original name has a pathname-name of "orig" and a ;; pathname-type of "dir", the new file name is merged to ;; produce a pathname-name of "new" with a pathname-type of ;; "dir". (rename-file "orig.dir" "new") (let ((orig (merge-pathnames (make-pathname :directory '(:relative "orig.dir")))) (new (merge-pathnames (make-pathname :directory '(:relative "new.dir"))))) ;; Ensure that the rename worked and that the returned values ;; have the expected values. (assert-true defaulted-new-name) (assert-equalp old-truename orig) (assert-equalp new-truename new))))) (define-test issue.132.3 (:tag :issues) (assert-true (ensure-directories-exist "dir/orig.dir/")) (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory)))) (multiple-value-bind (defaulted-new-name old-truename new-truename) ;; Rename "dir/orig.dir/" to "orig/new". Note that the ;; original name is "orig.dir/" which marks a directory so ;; that when we merge the new name with the old to fill in ;; missing components, there are none because the old name is ;; a directory with no pathname-name or pathname-type, so the ;; new name stays the same. (rename-file "orig.dir/" "new") (let ((orig (merge-pathnames (make-pathname :directory '(:relative "orig.dir")))) (new (merge-pathnames (make-pathname :directory '(:relative "new"))))) ;; Ensure that the rename worked and that the returned values ;; have the expected values. (assert-true defaulted-new-name) (assert-equalp old-truename orig) (assert-equalp new-truename new))))) Loading
src/code/filesys.lisp +5 −1 Original line number Diff line number Diff line Loading @@ -950,7 +950,11 @@ File after it was renamed." (let* ((original (truename file)) (original-namestring (unix-namestring original t)) (new-name (merge-pathnames new-name file)) ;; First, merge NEW-FILE-NAME with *DEFAULT-PATHNAME-DEFAULTS* to ;; fill in the missing components and then merge again with ;; the FILE to get any missing components from FILE. (new-name (merge-pathnames (merge-pathnames new-name) file)) (new-namestring (unix-namestring new-name nil))) (unless new-namestring (error 'simple-file-error Loading
tests/issues.lisp +66 −0 Original line number Diff line number Diff line Loading @@ -579,3 +579,69 @@ with user-info = (unix:unix-getpwuid uid) while user-info finally (assert-false user-info))) (define-test issue.132.1 (:tag :issues) ;; From a message on cmucl-imp 2008/06/01. If "d1" is a directory, ;; (rename "d1" "d2") should rename the directory "d1" to "d2". ;; Previously that produced an error trying to rename "d1" to ;; "d1/d2". ;; ;; Create the test directory (that is a subdirectory of "dir"). (assert-true (ensure-directories-exist "dir/orig-dir/")) (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory)))) (multiple-value-bind (defaulted-new-name old-truename new-truename) ;; Rename "dir/orig-dir" to "orig/new-dir". (rename-file "orig-dir/" "new-dir") (let ((orig (merge-pathnames (make-pathname :directory '(:relative "orig-dir")))) (new (merge-pathnames (make-pathname :directory '(:relative "new-dir"))))) ;; Ensure that the rename worked and that the returned values ;; have the expected values. (assert-true defaulted-new-name) (assert-equalp old-truename orig) (assert-equalp new-truename new))))) (define-test issue.132.2 (:tag :issues) (assert-true (ensure-directories-exist "dir/orig.dir/")) (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory)))) (multiple-value-bind (defaulted-new-name old-truename new-truename) ;; Rename "dir/orig.dir" to "orig/new-dir". Since the ;; original name has a pathname-name of "orig" and a ;; pathname-type of "dir", the new file name is merged to ;; produce a pathname-name of "new" with a pathname-type of ;; "dir". (rename-file "orig.dir" "new") (let ((orig (merge-pathnames (make-pathname :directory '(:relative "orig.dir")))) (new (merge-pathnames (make-pathname :directory '(:relative "new.dir"))))) ;; Ensure that the rename worked and that the returned values ;; have the expected values. (assert-true defaulted-new-name) (assert-equalp old-truename orig) (assert-equalp new-truename new))))) (define-test issue.132.3 (:tag :issues) (assert-true (ensure-directories-exist "dir/orig.dir/")) (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory)))) (multiple-value-bind (defaulted-new-name old-truename new-truename) ;; Rename "dir/orig.dir/" to "orig/new". Note that the ;; original name is "orig.dir/" which marks a directory so ;; that when we merge the new name with the old to fill in ;; missing components, there are none because the old name is ;; a directory with no pathname-name or pathname-type, so the ;; new name stays the same. (rename-file "orig.dir/" "new") (let ((orig (merge-pathnames (make-pathname :directory '(:relative "orig.dir")))) (new (merge-pathnames (make-pathname :directory '(:relative "new"))))) ;; Ensure that the rename worked and that the returned values ;; have the expected values. (assert-true defaulted-new-name) (assert-equalp old-truename orig) (assert-equalp new-truename new)))))