[Git][cmucl/cmucl][issue-132-ansi-test-rename-files] 2 commits: Add two more tests for RENAME-FILE

[Raymond Toy (@rtoy)]

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/127d8235e5c2553e359af9e084b3bcc80ac24c61...38e9d88e60684a29c269569549909de492c6a08a

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/127d8235e5c2553e359af9e084b3bcc80ac24c61...38e9d88e60684a29c269569549909de492c6a08a
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20220916/f8e18ec0/attachment-0001.html>