Raymond Toy pushed to branch issue-132-ansi-test-rename-files at cmucl / cmucl
Commits: 2a4c3765 by Raymond Toy at 2022-09-16T13:53:26-07:00 Add two more tests for RENAME-FILE
One tests renaming the directory "dir/orig.dir" to "dir/new.dir" because we call `(rename-file "orig.dir" "new")` and the old file name has a pathname-name of "orig" and a pathname-type of "dir" so the new file name has the missing components filled in to produce "new.dir".
The second test does `(rename-file "orig.dir/" "new")`. The original file has no name or type, so merging "new" adds nothing and we rename "orig.dir" to just "new".
- - - - - 38e9d88e by Raymond Toy at 2022-09-16T13:53:56-07:00 Undo change as requested by reviewer
- - - - -
2 changed files:
- .gitlab-ci.yml - tests/issues.lisp
Changes:
===================================== .gitlab-ci.yml ===================================== @@ -80,7 +80,7 @@ linux:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep -a 'unexpected (successes|failures)' test.out + - grep 'No unexpected (successes|failures)' test.out
linux:benchmark: stage: benchmark
===================================== tests/issues.lisp ===================================== @@ -580,7 +580,7 @@ while user-info finally (assert-false user-info)))
-(define-test issue.132 +(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". @@ -588,7 +588,7 @@ ;; "d1/d2". ;; ;; Create the test directory (that is a subdirectory of "dir"). - (assert (ensure-directories-exist "dir/orig-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". @@ -599,7 +599,49 @@ (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)))))) - + (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)))))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/127d8235e5c2553e359af9e...