Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
-
a05277c7
by Raymond Toy at 2022-10-15T20:53:20+00:00
-
4dacd5ac
by Raymond Toy at 2022-10-15T20:53:20+00:00
2 changed files:
Changes:
| ... | ... | @@ -510,12 +510,12 @@ |
| 510 | 510 | (* base power)
|
| 511 | 511 | (exp (* power (* (log2 base 1w0) (log 2w0))))))
|
| 512 | 512 | (((foreach fixnum (or bignum ratio) single-float)
|
| 513 | - (foreach (complex single-float)))
|
|
| 513 | + (foreach (complex rational) (complex single-float)))
|
|
| 514 | 514 | (if (and (zerop base) (plusp (realpart power)))
|
| 515 | 515 | (* base power)
|
| 516 | 516 | (exp (* power (log base)))))
|
| 517 | 517 | (((foreach (complex rational) (complex single-float))
|
| 518 | - (foreach single-float (complex single-float)))
|
|
| 518 | + (foreach single-float (complex rational) (complex single-float)))
|
|
| 519 | 519 | (if (and (zerop base) (plusp (realpart power)))
|
| 520 | 520 | (* base power)
|
| 521 | 521 | (or (expt-xfrm (coerce base '(complex single-float)) power)
|
| ... | ... | @@ -537,7 +537,7 @@ |
| 537 | 537 | (exp (* power (log (coerce base '(complex double-double-float))))))))
|
| 538 | 538 | (((foreach (complex double-float))
|
| 539 | 539 | (foreach single-float double-float
|
| 540 | - (complex single-float) (complex double-float)))
|
|
| 540 | + (complex rational) (complex single-float) (complex double-float)))
|
|
| 541 | 541 | (if (and (zerop base) (plusp (realpart power)))
|
| 542 | 542 | (* base power)
|
| 543 | 543 | (or (expt-xfrm base power)
|
| ... | ... | @@ -552,7 +552,7 @@ |
| 552 | 552 | (exp (* power (log (coerce base '(complex double-double-float))))))))
|
| 553 | 553 | #+double-double
|
| 554 | 554 | (((foreach (complex double-double-float))
|
| 555 | - (foreach float (complex float)))
|
|
| 555 | + (foreach float (complex float) (complex rational)))
|
|
| 556 | 556 | (if (and (zerop base) (plusp (realpart power)))
|
| 557 | 557 | (* base power)
|
| 558 | 558 | (or (expt-xfrm base power)
|
| ... | ... | @@ -645,3 +645,28 @@ |
| 645 | 645 | (assert-true defaulted-new-name)
|
| 646 | 646 | (assert-equalp old-truename orig)
|
| 647 | 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 | + |