Raymond Toy pushed to branch issue-298-with-float-rounding-mode at cmucl / cmucl

Commits: bf417b47 by Raymond Toy at 2024-04-02T08:33:30-07:00 Update cmucl.pot with new docstrings

- - - - - e32034e0 by Raymond Toy at 2024-04-02T08:33:52-07:00 Add tests for with-float-rounding-mode

Not 100% sure the expected results are right. They seem plausible, but I didn't actually analyze that the rounding is correct.

- - - - -

2 changed files:

- src/i18n/locale/cmucl.pot - tests/float.lisp

Changes:

===================================== src/i18n/locale/cmucl.pot ===================================== @@ -4868,6 +4868,25 @@ msgid "" " their testing within, and restored on exit." msgstr ""

+#: src/code/float-trap.lisp +msgid "" +"Execute BODY with the floating-point rounding mode set to\n" +" ROUNDING-MODE. ROUNDING-MODE must a one of\n" +"\n" +" :NEAREST\n" +" the default mode of round to nearest even\n" +" :ZERO\n" +" round numbers down towards zero. Positive numbers round down\n" +" and negative numbers round up.\n" +" :POSITIVE-INFINITY\n" +" round numbers up towards positive infinity\n" +" :NEGATIVE-INFINITY\n" +" round numbers down towards negative infinity\n" +"\n" +" Only the rounding mode is restored on exit; other floating-point\n" +" modes are not modified. " +msgstr "" + #: src/code/float.lisp msgid "Return true if the float X is denormalized." msgstr ""

===================================== tests/float.lisp ===================================== @@ -212,3 +212,38 @@ ;; most-positive-double-float. And a really big single-float. (assert-error 'reader-error (read-from-string "1.8d308")) (assert-error 'reader-error (read-from-string "1d999999999"))) + +(defun rounding-test (x) + (declare (double-float x) + (optimize (speed 3))) + (* x (/ 1d0 x))) + +(define-test rounding-mode.nearest + (:tag :issues) + (ext:with-float-rounding-mode (:nearest) + (assert-equal 1d0 (rounding-test 3d0)))) + +(define-test rounding-mode.zero.1 + (:tag :issues) + (ext:with-float-rounding-mode (:zero) + (assert-equal 0.9999999999999999d0 + (rounding-test 3d0)))) + +(define-test rounding-mode.zero.2 + (:tag :issues) + (ext:with-float-rounding-mode (:zero) + (assert-equal 0.9999999999999999d0 + (rounding-test -3d0)))) + +(define-test rounding-mode.positive-infinity + (:tag :issues) + (ext:with-float-rounding-mode (:positive-infinity) + (assert-equal 1.0000000000000002d0 + (rounding-test 3d0)))) + +(define-test rounding-mode.negative-infinity + (:tag :issues) + (ext:with-float-rounding-mode (:negative-infinity) + (assert-equal 0.9999999999999999d0 + (rounding-test 3d0)))) +

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