[Git][cmucl/cmucl][issue-136-ansi-test-ensure-directories-exist.8] 5 commits: Fix #132: Ansi test RENAME-FILE.1 fails
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Sat Oct 15 23:32:21 UTC 2022
Raymond Toy pushed to branch issue-136-ansi-test-ensure-directories-exist.8 at cmucl / cmucl
Commits:
cdd7d328 by Raymond Toy at 2022-10-15T14:39:32+00:00
Fix #132: Ansi test RENAME-FILE.1 fails
- - - - -
e0e9f62d by Raymond Toy at 2022-10-15T14:39:35+00:00
Merge branch 'issue-132-ansi-test-rename-files' into 'master'
Fix #132: Ansi test RENAME-FILE.1 fails
Closes #132
See merge request cmucl/cmucl!90
- - - - -
a05277c7 by Raymond Toy at 2022-10-15T20:53:20+00:00
Fix #134: Handle the case of (expt complex complex-rational)
- - - - -
4dacd5ac by Raymond Toy at 2022-10-15T20:53:20+00:00
Merge branch 'issue-134-expt-bug' into 'master'
Fix #134: Handle the case of (expt complex complex-rational)
Closes #134
See merge request cmucl/cmucl!91
- - - - -
ecd27449 by Raymond Toy at 2022-10-15T16:32:03-07:00
Merge branch 'master' into issue-136-ansi-test-ensure-directories-exist.8
- - - - -
3 changed files:
- src/code/filesys.lisp
- src/code/irrat.lisp
- tests/issues.lisp
Changes:
=====================================
src/code/filesys.lisp
=====================================
@@ -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
=====================================
src/code/irrat.lisp
=====================================
@@ -510,12 +510,12 @@
(* base power)
(exp (* power (* (log2 base 1w0) (log 2w0))))))
(((foreach fixnum (or bignum ratio) single-float)
- (foreach (complex single-float)))
+ (foreach (complex rational) (complex single-float)))
(if (and (zerop base) (plusp (realpart power)))
(* base power)
(exp (* power (log base)))))
(((foreach (complex rational) (complex single-float))
- (foreach single-float (complex single-float)))
+ (foreach single-float (complex rational) (complex single-float)))
(if (and (zerop base) (plusp (realpart power)))
(* base power)
(or (expt-xfrm (coerce base '(complex single-float)) power)
@@ -537,7 +537,7 @@
(exp (* power (log (coerce base '(complex double-double-float))))))))
(((foreach (complex double-float))
(foreach single-float double-float
- (complex single-float) (complex double-float)))
+ (complex rational) (complex single-float) (complex double-float)))
(if (and (zerop base) (plusp (realpart power)))
(* base power)
(or (expt-xfrm base power)
@@ -552,7 +552,7 @@
(exp (* power (log (coerce base '(complex double-double-float))))))))
#+double-double
(((foreach (complex double-double-float))
- (foreach float (complex float)))
+ (foreach float (complex float) (complex rational)))
(if (and (zerop base) (plusp (realpart power)))
(* base power)
(or (expt-xfrm base power)
=====================================
tests/issues.lisp
=====================================
@@ -579,3 +579,94 @@
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)))))
+
+(define-test issue.134
+ (:tag :issues)
+ ;; Verify that we can compute (3+4*%i)^%i (in Maxima format). This
+ ;; can be written analytically as
+ ;; %i*%e^-atan(4/3)*sin(log(5))+%e^-atan(4/3)*cos(log(5)), so use
+ ;; %this as the reference value.
+ (let ((answer (complex (* (cos (log 5w0))
+ (exp (- (atan (float (/ 4 3) 0w0)))))
+ (* (sin (log 5w0))
+ (exp (- (atan (float (/ 4 3) 0w0))))))))
+ (flet ((relerr (actual true)
+ ;; Return the relative error between ACTUAL and TRUE
+ (/ (abs (- actual true))
+ (abs true))))
+ (dolist (test '((#c(3 4) 3.5918w-8)
+ (#c(3.0 4) 3.5918w-8)
+ (#c(3d0 4) 9.2977w-17)
+ (#c(3w0 4) 0w0)))
+ (destructuring-bind (base eps)
+ test
+ (let* ((value (expt base #c(0 1)))
+ (err (relerr value answer)))
+ (assert-true (<= err eps) base err eps)))))))
+
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/c59de890d9e63d007d56ac32a93d55424cf57f2c...ecd274491a940b3d7387c969141ef32a042aad61
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/c59de890d9e63d007d56ac32a93d55424cf57f2c...ecd274491a940b3d7387c969141ef32a042aad61
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/20221015/5bbf9fd3/attachment-0001.html>
More information about the cmucl-cvs
mailing list