... |
... |
@@ -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))))) |