Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
-
c40327d1
by Raymond Toy at 2024-04-19T14:13:56+00:00
-
787626ad
by Raymond Toy at 2024-04-19T14:14:04+00:00
5 changed files:
- src/code/bignum.lisp
- src/code/reader.lisp
- src/general-info/release-21f.md
- src/i18n/locale/cmucl.pot
- tests/float.lisp
Changes:
| ... | ... | @@ -2032,7 +2032,7 @@ down to individual words.") |
| 2032 | 2032 | (declare (type bignum-index len))
|
| 2033 | 2033 | (let ((exp (+ exp bias)))
|
| 2034 | 2034 | (when (> exp max)
|
| 2035 | - (error 'simple-type-error
|
|
| 2035 | + (error 'floating-point-overflow
|
|
| 2036 | 2036 | :datum x
|
| 2037 | 2037 | :format-control (intl:gettext "Too large to be represented as a ~S:~% ~S")
|
| 2038 | 2038 | :format-arguments (list format x)
|
| ... | ... | @@ -1823,6 +1823,51 @@ the end of the stream." |
| 1823 | 1823 | num))))
|
| 1824 | 1824 | (t (error _"Internal error in floating point reader.")))))
|
| 1825 | 1825 | |
| 1826 | +(defun restart-overflow (sign-num sign-div float-format stream)
|
|
| 1827 | + (flet
|
|
| 1828 | + ((floating-point-infinity (sign float-format)
|
|
| 1829 | + (ecase float-format
|
|
| 1830 | + ((short-float single-float)
|
|
| 1831 | + (if (minusp sign)
|
|
| 1832 | + ext:single-float-negative-infinity
|
|
| 1833 | + ext:single-float-positive-infinity))
|
|
| 1834 | + ((double-float long-float)
|
|
| 1835 | + (if (minusp sign)
|
|
| 1836 | + ext:double-float-negative-infinity
|
|
| 1837 | + ext:double-float-positive-infinity))
|
|
| 1838 | + #+double-double
|
|
| 1839 | + ((kernel::double-double-float)
|
|
| 1840 | + (if (minusp sign)
|
|
| 1841 | + kernel::double-double-float-negative-infinity
|
|
| 1842 | + kernel::double-double-float-positive-infinity))))
|
|
| 1843 | + (largest-float (sign float-format)
|
|
| 1844 | + (ecase float-format
|
|
| 1845 | + ((short-float single-float)
|
|
| 1846 | + (if (minusp sign)
|
|
| 1847 | + most-negative-single-float
|
|
| 1848 | + most-positive-single-float))
|
|
| 1849 | + ((double-float long-float)
|
|
| 1850 | + (if (minusp sign)
|
|
| 1851 | + most-negative-double-float
|
|
| 1852 | + most-positive-double-float))
|
|
| 1853 | + #+double-double
|
|
| 1854 | + ((kernel::double-double-float)
|
|
| 1855 | + (if (minusp sign)
|
|
| 1856 | + ext:most-negative-double-double-float
|
|
| 1857 | + ext:most-positive-double-double-float)))))
|
|
| 1858 | + |
|
| 1859 | + (restart-case
|
|
| 1860 | + (%reader-error stream _"Floating-point overflow reading ~S: ~S"
|
|
| 1861 | + float-format (read-buffer-to-string))
|
|
| 1862 | + (infinity ()
|
|
| 1863 | + :report (lambda (stream)
|
|
| 1864 | + (format stream "Return floating-point infinity"))
|
|
| 1865 | + (floating-point-infinity (* sign-num sign-div) float-format))
|
|
| 1866 | + (largest-float ()
|
|
| 1867 | + :report (lambda (stream)
|
|
| 1868 | + (format stream "Return largest floating-point value"))
|
|
| 1869 | + (largest-float (* sign-num sign-div) float-format)))))
|
|
| 1870 | + |
|
| 1826 | 1871 | (defun make-float-aux (exponent number divisor float-format stream)
|
| 1827 | 1872 | ;; Computes x = number*10^exponent/divisor.
|
| 1828 | 1873 | ;;
|
| ... | ... | @@ -1867,7 +1912,7 @@ the end of the stream." |
| 1867 | 1912 | (error 'floating-point-underflow))
|
| 1868 | 1913 | (when (>= log2-num log2-high)
|
| 1869 | 1914 | ;; Number is definitely too large; signal an error
|
| 1870 | - (error "Overflow"))))))))
|
|
| 1915 | + (error 'floating-point-overflow))))))))
|
|
| 1871 | 1916 | |
| 1872 | 1917 | ;; Otherwise the number might fit, so we carefully compute the result.
|
| 1873 | 1918 | (handler-case
|
| ... | ... | @@ -1893,11 +1938,15 @@ the end of the stream." |
| 1893 | 1938 | :report (lambda (stream)
|
| 1894 | 1939 | (format stream "Return ~A" zero))
|
| 1895 | 1940 | zero))))
|
| 1941 | + (floating-point-overflow ()
|
|
| 1942 | + ;; Resignal a reader error, but allow the user to replace
|
|
| 1943 | + ;; overflow with another value.
|
|
| 1944 | + (restart-overflow (signum number) (signum divisor)
|
|
| 1945 | + float-format stream))
|
|
| 1896 | 1946 | (error ()
|
| 1897 | 1947 | (%reader-error stream _"Number not representable as a ~S: ~S"
|
| 1898 | 1948 | float-format (read-buffer-to-string))))))
|
| 1899 | 1949 | |
| 1900 | - |
|
| 1901 | 1950 | (defun make-ratio (stream)
|
| 1902 | 1951 | ;;assume *read-buffer* contains a legal ratio. Build the number from
|
| 1903 | 1952 | ;;the string.
|
| ... | ... | @@ -66,6 +66,7 @@ public domain. |
| 66 | 66 | * ~~#288~~ Re-enable `deftransform` for random integers.
|
| 67 | 67 | * ~~#290~~ Pprint `with-float-traps-masked` better
|
| 68 | 68 | * ~~#291~~ Pprint `handler-case` neatly.
|
| 69 | + * ~~#293~~ Allow restarts for FP overflow in reader.
|
|
| 69 | 70 | * ~~#297~~ Pprint `new-assem:assemble` with less indentation.
|
| 70 | 71 | * Other changes:
|
| 71 | 72 | * Improvements to the PCL implementation of CLOS:
|
| ... | ... | @@ -8749,6 +8749,10 @@ msgstr "" |
| 8749 | 8749 | msgid "Internal error in floating point reader."
|
| 8750 | 8750 | msgstr ""
|
| 8751 | 8751 | |
| 8752 | +#: src/code/reader.lisp
|
|
| 8753 | +msgid "Floating-point overflow reading ~S: ~S"
|
|
| 8754 | +msgstr ""
|
|
| 8755 | + |
|
| 8752 | 8756 | #: src/code/reader.lisp
|
| 8753 | 8757 | msgid "Floating point underflow when reading ~S: ~S"
|
| 8754 | 8758 | msgstr ""
|
| ... | ... | @@ -287,4 +287,49 @@ |
| 287 | 287 | (invoke-restart 'lisp::continue))))
|
| 288 | 288 | (read-from-string string)))))))
|
| 289 | 289 |
|
| 290 | +(define-test fp-overflow-restarts.infinity
|
|
| 291 | + (:tag :issues)
|
|
| 292 | + ;; Test that the "infinity" restart from reader on floating-point
|
|
| 293 | + ;; overflow returns an infinity of the correct type and sign.
|
|
| 294 | + (dolist (item (list (list "4e38" ext:single-float-positive-infinity)
|
|
| 295 | + (list "-4e38" ext:single-float-negative-infinity)
|
|
| 296 | + (list "2d308" ext:double-float-positive-infinity)
|
|
| 297 | + (list "-2d308" ext:double-float-negative-infinity)
|
|
| 298 | + ;; These test the short-cut case in the reader for
|
|
| 299 | + ;; very large numbers.
|
|
| 300 | + (list "4e999" ext:single-float-positive-infinity)
|
|
| 301 | + (list "-4e999" ext:single-float-negative-infinity)
|
|
| 302 | + (list "1d999" ext:double-float-positive-infinity)
|
|
| 303 | + (list "-1d999" ext:double-float-negative-infinity)))
|
|
| 304 | + (destructuring-bind (string expected-result)
|
|
| 305 | + item
|
|
| 306 | + (assert-equal expected-result
|
|
| 307 | + (values (handler-bind ((reader-error
|
|
| 308 | + (lambda (c)
|
|
| 309 | + (declare (ignore c))
|
|
| 310 | + (invoke-restart 'lisp::infinity))))
|
|
| 311 | + (read-from-string string)))))))
|
|
| 290 | 312 | |
| 313 | +(define-test fp-overflow-restarts.huge
|
|
| 314 | + (:tag :issues)
|
|
| 315 | + ;; Test that the "largest-float" restart from reader on
|
|
| 316 | + ;; floating-point overflow returns the largest float of the correct
|
|
| 317 | + ;; type and sign.
|
|
| 318 | + (dolist (item (list (list "4e38" most-positive-single-float)
|
|
| 319 | + (list "-4e38" most-negative-single-float)
|
|
| 320 | + (list "2d308" most-positive-double-float)
|
|
| 321 | + (list "-2d308" most-negative-double-float)
|
|
| 322 | + ;; These test the short-cut case in the reader for
|
|
| 323 | + ;; very large numbers.
|
|
| 324 | + (list "4e999" most-positive-single-float)
|
|
| 325 | + (list "-4e999" most-negative-single-float)
|
|
| 326 | + (list "1d999" most-positive-double-float)
|
|
| 327 | + (list "-1d999" most-negative-double-float)))
|
|
| 328 | + (destructuring-bind (string expected-result)
|
|
| 329 | + item
|
|
| 330 | + (assert-equal expected-result
|
|
| 331 | + (handler-bind ((reader-error
|
|
| 332 | + (lambda (c)
|
|
| 333 | + (declare (ignore c))
|
|
| 334 | + (values (invoke-restart 'lisp::largest-float)))))
|
|
| 335 | + (read-from-string string)))))) |