Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/code/filesys.lisp
    ... ... @@ -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 file))
    
    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-name)
    
    957
    +				    file))
    
    954 958
     	 (new-namestring (unix-namestring new-name nil)))
    
    955 959
         (unless new-namestring
    
    956 960
           (error 'simple-file-error
    

  • tests/issues.lisp
    ... ... @@ -579,3 +579,69 @@
    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.1
    
    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-true (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-true defaulted-new-name)
    
    603
    +	(assert-equalp old-truename orig)
    
    604
    +	(assert-equalp new-truename new)))))
    
    605
    +
    
    606
    +(define-test issue.132.2
    
    607
    +    (:tag :issues)
    
    608
    +  (assert-true (ensure-directories-exist "dir/orig.dir/"))
    
    609
    +  (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory))))
    
    610
    +    (multiple-value-bind (defaulted-new-name old-truename new-truename)
    
    611
    +	;; Rename "dir/orig.dir" to "orig/new-dir".  Since the
    
    612
    +	;; original name has a pathname-name of "orig" and a
    
    613
    +	;; pathname-type of "dir", the new file name is merged to
    
    614
    +	;; produce a pathname-name of "new" with a pathname-type of
    
    615
    +	;; "dir".
    
    616
    +	(rename-file "orig.dir" "new")
    
    617
    +      (let ((orig (merge-pathnames
    
    618
    +		   (make-pathname :directory '(:relative "orig.dir"))))
    
    619
    +	    (new (merge-pathnames
    
    620
    +		  (make-pathname :directory '(:relative "new.dir")))))
    
    621
    +	;; Ensure that the rename worked and that the returned values
    
    622
    +	;; have the expected values.
    
    623
    +	(assert-true defaulted-new-name)
    
    624
    +	(assert-equalp old-truename orig)
    
    625
    +	(assert-equalp new-truename new)))))
    
    626
    +
    
    627
    +(define-test issue.132.3
    
    628
    +    (:tag :issues)
    
    629
    +  (assert-true (ensure-directories-exist "dir/orig.dir/"))
    
    630
    +  (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory))))
    
    631
    +    (multiple-value-bind (defaulted-new-name old-truename new-truename)
    
    632
    +	;; Rename "dir/orig.dir/" to "orig/new".  Note that the
    
    633
    +	;; original name is "orig.dir/" which marks a directory so
    
    634
    +	;; that when we merge the new name with the old to fill in
    
    635
    +	;; missing components, there are none because the old name is
    
    636
    +	;; a directory with no pathname-name or pathname-type, so the
    
    637
    +	;; new name stays the same.
    
    638
    +	(rename-file "orig.dir/" "new")
    
    639
    +      (let ((orig (merge-pathnames
    
    640
    +		   (make-pathname :directory '(:relative "orig.dir"))))
    
    641
    +	    (new (merge-pathnames
    
    642
    +		  (make-pathname :directory '(:relative "new")))))
    
    643
    +	;; Ensure that the rename worked and that the returned values
    
    644
    +	;; have the expected values.
    
    645
    +	(assert-true defaulted-new-name)
    
    646
    +	(assert-equalp old-truename orig)
    
    647
    +	(assert-equalp new-truename new)))))