... |
... |
@@ -580,6 +580,96 @@ |
580
|
580
|
while user-info
|
581
|
581
|
finally (assert-false user-info)))
|
582
|
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)))))
|
|
648
|
+
|
|
649
|
+(define-test issue.134
|
|
650
|
+ (:tag :issues)
|
|
651
|
+ ;; Verify that we can compute (3+4*%i)^%i (in Maxima format). This
|
|
652
|
+ ;; can be written analytically as
|
|
653
|
+ ;; %i*%e^-atan(4/3)*sin(log(5))+%e^-atan(4/3)*cos(log(5)), so use
|
|
654
|
+ ;; %this as the reference value.
|
|
655
|
+ (let ((answer (complex (* (cos (log 5w0))
|
|
656
|
+ (exp (- (atan (float (/ 4 3) 0w0)))))
|
|
657
|
+ (* (sin (log 5w0))
|
|
658
|
+ (exp (- (atan (float (/ 4 3) 0w0))))))))
|
|
659
|
+ (flet ((relerr (actual true)
|
|
660
|
+ ;; Return the relative error between ACTUAL and TRUE
|
|
661
|
+ (/ (abs (- actual true))
|
|
662
|
+ (abs true))))
|
|
663
|
+ (dolist (test '((#c(3 4) 3.5918w-8)
|
|
664
|
+ (#c(3.0 4) 3.5918w-8)
|
|
665
|
+ (#c(3d0 4) 9.2977w-17)
|
|
666
|
+ (#c(3w0 4) 0w0)))
|
|
667
|
+ (destructuring-bind (base eps)
|
|
668
|
+ test
|
|
669
|
+ (let* ((value (expt base #c(0 1)))
|
|
670
|
+ (err (relerr value answer)))
|
|
671
|
+ (assert-true (<= err eps) base err eps)))))))
|
|
672
|
+
|
583
|
673
|
(define-test issue.140
|
584
|
674
|
(:tag :issues)
|
585
|
675
|
;; Make sure *standard-input* is a two-way-stream
|