Raymond Toy pushed to branch issue-132-ansi-test-rename-files at cmucl / cmucl Commits: 127d8235 by Raymond Toy at 2022-09-16T12:58:47-07:00 Fix so renaming directories does the expected thing. To do this, we need to merge the new name with *default-pathname-defaults* to fill in the directory components if needed. Then we merge that with the original name to fill any unfilled components. Add a test for this where we rename "dir/orig-dir" to "dir/new-dir". - - - - - 2 changed files: - src/code/filesys.lisp - tests/issues.lisp Changes: ===================================== src/code/filesys.lisp ===================================== @@ -940,7 +940,7 @@ ;;; Rename-File -- Public ;;; -(defun rename-file (file new-name) +(defun rename-file (file new-file-name) "Rename File to have the specified New-Name. If file is a stream open to a file, then the associated file is renamed. @@ -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 original)) + ;; 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-file-name) + file)) (new-namestring (unix-namestring new-name nil))) (unless new-namestring (error 'simple-file-error @@ -968,7 +972,9 @@ (unix:get-unix-error-msg error)))) (when (streamp file) (file-name file new-namestring)) - (values new-name original (truename new-name))))) + (values new-name + original + (truename new-name))))) ;;; Delete-File -- Public ;;; ===================================== tests/issues.lisp ===================================== @@ -579,3 +579,27 @@ with user-info = (unix:unix-getpwuid uid) while user-info finally (assert-false user-info))) + +(define-test issue.132 + (: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 (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 defaulted-new-name) + (assert (equalp old-truename orig)) + (assert (equalp new-truename new)))))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/127d8235e5c2553e359af9e0... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/127d8235e5c2553e359af9e0... You're receiving this email because of your account on gitlab.common-lisp.net.