Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • cmucl/cmucl
  • pfominykh/cmucl
  • yitzchak/cmucl
  • rkreuter/cmucl
  • cshapiro/cmucl
5 results
Show changes
Commits on Source (5)
......@@ -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
......
......@@ -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)
......
......@@ -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)))))))