Raymond Toy pushed to branch issue-134-expt-bug at cmucl / cmucl Commits: cdd7d328 by Raymond Toy at 2022-10-15T14:39:32+00:00 Fix #132: Ansi test RENAME-FILE.1 fails - - - - - e0e9f62d by Raymond Toy at 2022-10-15T14:39:35+00:00 Merge branch 'issue-132-ansi-test-rename-files' into 'master' Fix #132: Ansi test RENAME-FILE.1 fails Closes #132 See merge request cmucl/cmucl!90 - - - - - 8dbf209c by Raymond Toy at 2022-10-15T07:42:45-07:00 Merge branch 'master' into issue-134-expt-bug - - - - - 2 changed files: - src/code/filesys.lisp - tests/issues.lisp Changes: ===================================== src/code/filesys.lisp ===================================== @@ -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 ===================================== tests/issues.lisp ===================================== @@ -580,6 +580,72 @@ 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))))) + (define-test issue.134 (:tag :issues) ;; Verify that we can compute (3+4*%i)^%i (in Maxima format). This @@ -603,3 +669,4 @@ (let* ((value (expt base #c(0 1))) (err (relerr value answer))) (assert-true (<= err eps) base err eps))))))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9bbb69f7b09556fcd35a52d... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9bbb69f7b09556fcd35a52d... You're receiving this email because of your account on gitlab.common-lisp.net.