Raymond Toy pushed to branch master at cmucl / cmucl Commits: 9dec6e71 by Raymond Toy at 2026-02-16T07:40:15-08:00 Fix #468: Make core-math signal the same errors as fdlibm - - - - - ec7e3a25 by Raymond Toy at 2026-02-16T07:40:15-08:00 Merge branch 'issue-468-core-math-signals' into 'master' Fix #468: Make core-math signal the same errors as fdlibm Closes #468, #426, and #425 See merge request cmucl/cmucl!347 - - - - - 2 changed files: - src/lisp/irrat.c - tests/fdlibm.lisp Changes: ===================================== src/lisp/irrat.c ===================================== @@ -39,10 +39,22 @@ extern void cr_sincos(double, double *, double *); * Wrappers for the special functions */ +#define MAYBE_SIGNAL_INVALID(test, val) \ + if ((test)) { \ + return fdlibm_setexception(val, FDLIBM_INVALID); \ + } + +#define MAYBE_SIGNAL_OVERFLOW(x) \ + if (isinf(x)) { \ + return fdlibm_setexception(x, FDLIBM_OVERFLOW); \ + } + double lisp_sin(double x) { #ifdef FEATURE_CORE_MATH + MAYBE_SIGNAL_INVALID(isinf(x), x) + return cr_sin(x); #else return fdlibm_sin(x); @@ -53,6 +65,8 @@ double lisp_cos(double x) { #ifdef FEATURE_CORE_MATH + MAYBE_SIGNAL_INVALID(isinf(x), x) + return cr_cos(x); #else return fdlibm_cos(x); @@ -63,6 +77,8 @@ double lisp_tan(double x) { #ifdef FEATURE_CORE_MATH + MAYBE_SIGNAL_INVALID(isinf(x), x) + return cr_tan(x); #else return fdlibm_tan(x); @@ -113,6 +129,8 @@ double lisp_sinh(double x) { #ifdef FEATURE_CORE_MATH + MAYBE_SIGNAL_OVERFLOW(x) + return cr_sinh(x); #else return __ieee754_sinh(x); @@ -143,6 +161,8 @@ double lisp_asinh(double x) { #ifdef FEATURE_CORE_MATH + MAYBE_SIGNAL_OVERFLOW(x) + return cr_asinh(x); #else return fdlibm_asinh(x); @@ -153,6 +173,10 @@ double lisp_acosh(double x) { #ifdef FEATURE_CORE_MATH + MAYBE_SIGNAL_INVALID(x < 1, x) + + MAYBE_SIGNAL_OVERFLOW(x) + return cr_acosh(x); #else return __ieee754_acosh(x); ===================================== tests/fdlibm.lisp ===================================== @@ -90,12 +90,8 @@ (define-test %acosh.exceptions (:tag :fdlibm) - ;; Core-math returns infinity instead of signaling overflow. - #-core-math (assert-error 'floating-point-overflow (kernel:%acosh ext:double-float-positive-infinity)) - ;; Core-math currently returns QNaN - #-core-math (assert-error 'floating-point-invalid-operation (kernel:%acosh 0d0)) (ext:with-float-traps-masked (:overflow) @@ -108,12 +104,8 @@ (:tag :fdlibm) (assert-error 'floating-point-invalid-operation (kernel:%asinh *snan*)) - ;; Core-math returns the signed infinity instead of signaling an - ;; overflow. - #-core-math (assert-error 'floating-point-overflow (kernel:%asinh ext:double-float-positive-infinity)) - #-core-math (assert-error 'floating-point-overflow (kernel:%asinh ext:double-float-negative-infinity)) (assert-true (ext:float-nan-p (kernel:%asinh *qnan*))) @@ -218,7 +210,6 @@ (ext:with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity (kernel:%exp 710d0))) - #-core-math (let ((modes (ext:get-floating-point-modes))) (unwind-protect (progn @@ -675,6 +666,14 @@ (define-test %cos.exceptions (:tag :fdlibm) + ;; cos(inf) signals invalid operation + (assert-error 'floating-point-invalid-operation + (kernel:%cos ext:double-float-positive-infinity)) + (assert-error 'floating-point-invalid-operation + (kernel:%cos ext:double-float-negative-infinity)) + ;; cos(nan) is NaN + (assert-true (ext:float-nan-p (kernel:%cos *qnan*))) + ;; cos(x) = 1 for |x| < 2^-27. Signal inexact unless x = 0 (let ((x (scale-float 1d0 -28)) (x0 0d0)) @@ -690,6 +689,14 @@ (define-test %sin.exceptions (:tag :fdlibm) + ;; sin(inf) signals invalid operation + (assert-error 'floating-point-invalid-operation + (kernel:%sin ext:double-float-positive-infinity)) + (assert-error 'floating-point-invalid-operation + (kernel:%sin ext:double-float-negative-infinity)) + ;; sin(nan) is NaN + (assert-true (ext:float-nan-p (kernel:%sin *qnan*))) + ;; sin(x) = x for |x| < 2^-27. Signal inexact unless x = 0 (let ((x (scale-float 1d0 -28)) (x0 0d0)) @@ -705,6 +712,14 @@ (define-test %tan.exceptions (:tag :fdlibm) + ;; tan(inf) signals invalid operation + (assert-error 'floating-point-invalid-operation + (kernel:%tan ext:double-float-positive-infinity)) + (assert-error 'floating-point-invalid-operation + (kernel:%tan ext:double-float-negative-infinity)) + ;; tan(nan) is NaN + (assert-true (ext:float-nan-p (kernel:%sin *qnan*))) + ;; tan(x) = x for |x| < 2^-28. Signal inexact unless x = 0 (let ((x (scale-float 1d0 -29)) (x0 0d0)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6ac1b6b434353fc47f45306... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6ac1b6b434353fc47f45306... You're receiving this email because of your account on gitlab.common-lisp.net.