Commit 2591a201 authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix #132: Ansi test RENAME-FILE.1 fails

parent 51d4f25b
Loading
Loading
Loading
Loading
+5 −1
Original line number Diff line number Diff line
@@ -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
+66 −0
Original line number Diff line number Diff line
@@ -579,3 +579,69 @@
	with user-info = (unix:unix-getpwuid uid)
	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)))))