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
-
e32034e0
by Raymond Toy at 2024-04-02T08:33:52-07:00
2 changed files:
Changes:
| ... | ... | @@ -4868,6 +4868,25 @@ msgid "" |
| 4868 | 4868 | " their testing within, and restored on exit."
|
| 4869 | 4869 | msgstr ""
|
| 4870 | 4870 | |
| 4871 | +#: src/code/float-trap.lisp
|
|
| 4872 | +msgid ""
|
|
| 4873 | +"Execute BODY with the floating-point rounding mode set to\n"
|
|
| 4874 | +" ROUNDING-MODE. ROUNDING-MODE must a one of\n"
|
|
| 4875 | +"\n"
|
|
| 4876 | +" :NEAREST\n"
|
|
| 4877 | +" the default mode of round to nearest even\n"
|
|
| 4878 | +" :ZERO\n"
|
|
| 4879 | +" round numbers down towards zero. Positive numbers round down\n"
|
|
| 4880 | +" and negative numbers round up.\n"
|
|
| 4881 | +" :POSITIVE-INFINITY\n"
|
|
| 4882 | +" round numbers up towards positive infinity\n"
|
|
| 4883 | +" :NEGATIVE-INFINITY\n"
|
|
| 4884 | +" round numbers down towards negative infinity\n"
|
|
| 4885 | +"\n"
|
|
| 4886 | +" Only the rounding mode is restored on exit; other floating-point\n"
|
|
| 4887 | +" modes are not modified. "
|
|
| 4888 | +msgstr ""
|
|
| 4889 | + |
|
| 4871 | 4890 | #: src/code/float.lisp
|
| 4872 | 4891 | msgid "Return true if the float X is denormalized."
|
| 4873 | 4892 | msgstr ""
|
| ... | ... | @@ -212,3 +212,38 @@ |
| 212 | 212 | ;; most-positive-double-float. And a really big single-float.
|
| 213 | 213 | (assert-error 'reader-error (read-from-string "1.8d308"))
|
| 214 | 214 | (assert-error 'reader-error (read-from-string "1d999999999")))
|
| 215 | + |
|
| 216 | +(defun rounding-test (x)
|
|
| 217 | + (declare (double-float x)
|
|
| 218 | + (optimize (speed 3)))
|
|
| 219 | + (* x (/ 1d0 x)))
|
|
| 220 | + |
|
| 221 | +(define-test rounding-mode.nearest
|
|
| 222 | + (:tag :issues)
|
|
| 223 | + (ext:with-float-rounding-mode (:nearest)
|
|
| 224 | + (assert-equal 1d0 (rounding-test 3d0))))
|
|
| 225 | + |
|
| 226 | +(define-test rounding-mode.zero.1
|
|
| 227 | + (:tag :issues)
|
|
| 228 | + (ext:with-float-rounding-mode (:zero)
|
|
| 229 | + (assert-equal 0.9999999999999999d0
|
|
| 230 | + (rounding-test 3d0))))
|
|
| 231 | + |
|
| 232 | +(define-test rounding-mode.zero.2
|
|
| 233 | + (:tag :issues)
|
|
| 234 | + (ext:with-float-rounding-mode (:zero)
|
|
| 235 | + (assert-equal 0.9999999999999999d0
|
|
| 236 | + (rounding-test -3d0))))
|
|
| 237 | + |
|
| 238 | +(define-test rounding-mode.positive-infinity
|
|
| 239 | + (:tag :issues)
|
|
| 240 | + (ext:with-float-rounding-mode (:positive-infinity)
|
|
| 241 | + (assert-equal 1.0000000000000002d0
|
|
| 242 | + (rounding-test 3d0))))
|
|
| 243 | + |
|
| 244 | +(define-test rounding-mode.negative-infinity
|
|
| 245 | + (:tag :issues)
|
|
| 246 | + (ext:with-float-rounding-mode (:negative-infinity)
|
|
| 247 | + (assert-equal 0.9999999999999999d0
|
|
| 248 | + (rounding-test 3d0))))
|
|
| 249 | + |