Raymond Toy pushed to branch master at cmucl / cmucl Commits: 4915f467 by Raymond Toy at 2018-07-22T10:14:55-07:00 Remove unused vars in WITH-FLOAT-TRAPS macro* The TRAPS and EXCEPTION vars in the WITH-FLOAT-TRAPS were unused. Remove them. Also add some tests for WITH-FLOAT-TRAPS-MASKED to verify that the traps are masked. - - - - - 2 changed files: - src/code/float-trap.lisp - tests/float.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -445,9 +445,7 @@ `(progn (defmacro ,macro-name (traps &body body) ,docstring - (let ((traps (dpb (float-trap-mask traps) float-traps-byte 0)) - (exceptions (dpb (float-trap-mask traps) float-sticky-bits 0)) - (trap-mask (dpb (lognot (float-trap-mask traps)) + (let ((trap-mask (dpb (lognot (float-trap-mask traps)) float-traps-byte #xffffffff)) (exception-mask (dpb (lognot (vm::float-trap-mask traps)) float-sticky-bits #xffffffff)) ===================================== tests/float.lisp ===================================== --- a/tests/float.lisp +++ b/tests/float.lisp @@ -116,3 +116,25 @@ f e))))) +(define-test float-traps-masked + ;; inf-inf signals invalid, which is masked so the result is NaN. + (assert-true + (ext:float-nan-p + (ext:with-float-traps-masked (:invalid) + (- ext:double-float-positive-infinity + ext:double-float-positive-infinity)))) + + ;; Divide-by-zero is masked so dividing by zero returns infinity + (assert-true + (ext:float-infinity-p + (ext:with-float-traps-masked (:divide-by-zero) + (/ 100d0 0d0)))) + + ;; Overflow is masked so 100 * most-positive-double returns infinity + (assert-true + (ext:float-infinity-p + (ext:with-float-traps-masked (:overflow) + (* 100 most-negative-double-float))))) + + + \ No newline at end of file View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/4915f4670f33130cf2d88b4e3f... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/4915f4670f33130cf2d88b4e3f... You're receiving this email because of your account on gitlab.common-lisp.net.