Raymond Toy pushed to branch master at cmucl / cmucl

Commits: 63ee590e by Raymond Toy at 2024-05-10T18:53:05+00:00 Fix #314: tanh incorrect for large args

- - - - - f661bac3 by Raymond Toy at 2024-05-10T18:53:09+00:00 Merge branch 'issue-314-complex-tanh-incorrect-for-large-arg' into 'master'

Fix #314: tanh incorrect for large args

Closes #314

See merge request cmucl/cmucl!219 - - - - -

3 changed files:

- src/code/irrat-dd.lisp - src/code/irrat.lisp - tests/irrat.lisp

Changes:

===================================== src/code/irrat-dd.lisp ===================================== @@ -1800,12 +1800,10 @@ Z may be any number, but the result is always a complex." (declare (optimize (speed 3) (space 0) (inhibit-warnings 3))) (cond ((> (abs x) - #-(or linux hpux) #.(/ (%asinh most-positive-double-float) 4d0) - ;; This is more accurate under linux. - #+(or linux hpux) #.(/ (+ (%log 2.0d0) - (%log most-positive-double-float)) 4d0)) + ;; Don't need double-double accuracy here. + #.(/ (%asinh most-positive-double-float) 4d0)) (complex (float-sign x) - (float-sign y))) + (float-sign y 0w0))) (t (let* ((tv (dd-%tan y)) (beta (+ 1.0d0 (* tv tv)))

===================================== src/code/irrat.lisp ===================================== @@ -1521,12 +1521,12 @@ Z may be any number, but the result is always a complex." ;; space 0 to get maybe-inline functions inlined (declare (optimize (speed 3) (space 0))) (cond ((> (abs x) - #-(or linux hpux) #.(/ (%asinh most-positive-double-float) 4d0) - ;; This is more accurate under linux. - #+(or linux hpux) #.(/ (+ (%log 2.0d0) - (%log most-positive-double-float)) 4d0)) + (/ (%asinh most-positive-double-float) 4d0)) + ;; Kahan says the answer is + ;; + ;; copysign(1, x) + i*copysign(0, y) (coerce-to-complex-type (float-sign x) - (float-sign y) z)) + (float-sign y 0d0) z)) (t (let* ((tv (%tan y)) (beta (+ 1.0d0 (* tv tv)))

===================================== tests/irrat.lisp ===================================== @@ -231,3 +231,17 @@ (let ((z (sqrt (complex minf (- nan))))) (assert-true (ext:float-nan-p (realpart z))) (assert-eql minf (imagpart z)))))) + +;; See bug #314 +(define-test tanh-large + (:tag :issues) + (assert-eql (complex 1d0 -0d0) + (tanh #c(200d0 -200d0))) + (assert-eql (complex 1d0 +0d0) + (tanh #c(200d0 +200d0))) + (assert-eql (complex 1w0 -0w0) + (tanh #c(200w0 -200w0))) + (assert-eql (complex 1w0 +0w0) + (tanh #c(200w0 200w0)))) + +

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b2fb3f8df03f6dac2c3b4a9...