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
2 changed files:
Changes:
| ... | ... | @@ -940,7 +940,7 @@ |
| 940 | 940 | |
| 941 | 941 | ;;; Rename-File -- Public
|
| 942 | 942 | ;;;
|
| 943 | -(defun rename-file (file new-name)
|
|
| 943 | +(defun rename-file (file new-file-name)
|
|
| 944 | 944 | "Rename File to have the specified New-Name. If file is a stream
|
| 945 | 945 | open to a file, then the associated file is renamed.
|
| 946 | 946 | |
| ... | ... | @@ -950,7 +950,11 @@ |
| 950 | 950 | File after it was renamed."
|
| 951 | 951 | (let* ((original (truename file))
|
| 952 | 952 | (original-namestring (unix-namestring original t))
|
| 953 | - (new-name (merge-pathnames new-name original))
|
|
| 953 | + ;; First, merge NEW-FILE-NAME with *DEFAULT-PATHNAME-DEFAULTS* to
|
|
| 954 | + ;; fill in the missing components and then merge again with
|
|
| 955 | + ;; the FILE to get any missing components from FILE.
|
|
| 956 | + (new-name (merge-pathnames (merge-pathnames new-file-name)
|
|
| 957 | + file))
|
|
| 954 | 958 | (new-namestring (unix-namestring new-name nil)))
|
| 955 | 959 | (unless new-namestring
|
| 956 | 960 | (error 'simple-file-error
|
| ... | ... | @@ -968,7 +972,9 @@ |
| 968 | 972 | (unix:get-unix-error-msg error))))
|
| 969 | 973 | (when (streamp file)
|
| 970 | 974 | (file-name file new-namestring))
|
| 971 | - (values new-name original (truename new-name)))))
|
|
| 975 | + (values new-name
|
|
| 976 | + original
|
|
| 977 | + (truename new-name)))))
|
|
| 972 | 978 | |
| 973 | 979 | ;;; Delete-File -- Public
|
| 974 | 980 | ;;;
|
| ... | ... | @@ -579,3 +579,27 @@ |
| 579 | 579 | with user-info = (unix:unix-getpwuid uid)
|
| 580 | 580 | while user-info
|
| 581 | 581 | finally (assert-false user-info)))
|
| 582 | + |
|
| 583 | +(define-test issue.132
|
|
| 584 | + (:tag :issues)
|
|
| 585 | + ;; From a message on cmucl-imp 2008/06/01. If "d1" is a directory,
|
|
| 586 | + ;; (rename "d1" "d2") should rename the directory "d1" to "d2".
|
|
| 587 | + ;; Previously that produced an error trying to rename "d1" to
|
|
| 588 | + ;; "d1/d2".
|
|
| 589 | + ;;
|
|
| 590 | + ;; Create the test directory (that is a subdirectory of "dir").
|
|
| 591 | + (assert (ensure-directories-exist "dir/orig-dir/"))
|
|
| 592 | + (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory))))
|
|
| 593 | + (multiple-value-bind (defaulted-new-name old-truename new-truename)
|
|
| 594 | + ;; Rename "dir/orig-dir" to "orig/new-dir".
|
|
| 595 | + (rename-file "orig-dir/" "new-dir")
|
|
| 596 | + (let ((orig (merge-pathnames
|
|
| 597 | + (make-pathname :directory '(:relative "orig-dir"))))
|
|
| 598 | + (new (merge-pathnames
|
|
| 599 | + (make-pathname :directory '(:relative "new-dir")))))
|
|
| 600 | + ;; Ensure that the rename worked and that the returned values
|
|
| 601 | + ;; have the expected values.
|
|
| 602 | + (assert defaulted-new-name)
|
|
| 603 | + (assert (equalp old-truename orig))
|
|
| 604 | + (assert (equalp new-truename new))))))
|
|
| 605 | + |