Raymond Toy pushed to branch rtoy-setexception-inexact at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/lisp/s_tanh.c
    --- a/src/lisp/s_tanh.c
    +++ b/src/lisp/s_tanh.c
    @@ -78,7 +78,9 @@ static double one=1.0, two=2.0, tiny = 1.0e-300;
     	    }
         /* |x| > 22, return +-1 */
     	} else {
    -	    z = one - tiny;		/* raised inexact flag */
    +	    /* Always raise inexact flag */
    +	    fdlibm_setexception(x, FDLIBM_INEXACT);
    +	    z = one - tiny;
     	}
     	return (jx>=0)? z: -z;
     }
    

  • tests/fdlibm.lisp
    --- a/tests/fdlibm.lisp
    +++ b/tests/fdlibm.lisp
    @@ -88,7 +88,14 @@
       (assert-error 'floating-point-invalid-operation
     		(kernel:%tanh *snan*))
       (kernel::with-float-traps-masked (:invalid)
    -    (assert-true (ext:float-nan-p (kernel:%tanh *snan*)))))
    +    (assert-true (ext:float-nan-p (kernel:%tanh *snan*))))
    +  ;; tanh(x) = +/- 1 for |x| > 22, raising inexact, always.
    +  (let ((x 22.1d0))
    +    (with-inexact-exception-enabled
    +	;; This must throw an inexact exception for non-zero x even
    +	;; though the result is exactly x.
    +	(assert-error 'floating-point-inexact
    +		      (kernel:%tanh x)))))
     
     (define-test %acosh.exceptions
       (:tag :fdlibm)