Commit 34a865ec authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix #134: Handle the case of (expt complex complex-rational)

parent 2591a201
Loading
Loading
Loading
Loading
+4 −4
Original line number Diff line number Diff line
@@ -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)
+25 −0
Original line number Diff line number Diff line
@@ -645,3 +645,28 @@
	(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)))))))