Raymond Toy pushed to branch master at cmucl / cmucl
Commits: c40327d1 by Raymond Toy at 2024-04-19T14:13:56+00:00 Fix #293: Allow restarts for FP overflow in reader
- - - - - 787626ad by Raymond Toy at 2024-04-19T14:14:04+00:00 Merge branch 'issue-293-restart-on-reader-fp-overflow' into 'master'
Fix #293: Allow restarts for FP overflow in reader
Closes #293, #275, and #287
See merge request cmucl/cmucl!201 - - - - -
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:
===================================== src/code/bignum.lisp ===================================== @@ -2032,7 +2032,7 @@ down to individual words.") (declare (type bignum-index len)) (let ((exp (+ exp bias))) (when (> exp max) - (error 'simple-type-error + (error 'floating-point-overflow :datum x :format-control (intl:gettext "Too large to be represented as a ~S:~% ~S") :format-arguments (list format x)
===================================== src/code/reader.lisp ===================================== @@ -1823,6 +1823,51 @@ the end of the stream." num)))) (t (error _"Internal error in floating point reader.")))))
+(defun restart-overflow (sign-num sign-div float-format stream) + (flet + ((floating-point-infinity (sign float-format) + (ecase float-format + ((short-float single-float) + (if (minusp sign) + ext:single-float-negative-infinity + ext:single-float-positive-infinity)) + ((double-float long-float) + (if (minusp sign) + ext:double-float-negative-infinity + ext:double-float-positive-infinity)) + #+double-double + ((kernel::double-double-float) + (if (minusp sign) + kernel::double-double-float-negative-infinity + kernel::double-double-float-positive-infinity)))) + (largest-float (sign float-format) + (ecase float-format + ((short-float single-float) + (if (minusp sign) + most-negative-single-float + most-positive-single-float)) + ((double-float long-float) + (if (minusp sign) + most-negative-double-float + most-positive-double-float)) + #+double-double + ((kernel::double-double-float) + (if (minusp sign) + ext:most-negative-double-double-float + ext:most-positive-double-double-float))))) + + (restart-case + (%reader-error stream _"Floating-point overflow reading ~S: ~S" + float-format (read-buffer-to-string)) + (infinity () + :report (lambda (stream) + (format stream "Return floating-point infinity")) + (floating-point-infinity (* sign-num sign-div) float-format)) + (largest-float () + :report (lambda (stream) + (format stream "Return largest floating-point value")) + (largest-float (* sign-num sign-div) float-format))))) + (defun make-float-aux (exponent number divisor float-format stream) ;; Computes x = number*10^exponent/divisor. ;; @@ -1867,7 +1912,7 @@ the end of the stream." (error 'floating-point-underflow)) (when (>= log2-num log2-high) ;; Number is definitely too large; signal an error - (error "Overflow")))))))) + (error 'floating-point-overflow))))))))
;; Otherwise the number might fit, so we carefully compute the result. (handler-case @@ -1893,11 +1938,15 @@ the end of the stream." :report (lambda (stream) (format stream "Return ~A" zero)) zero)))) + (floating-point-overflow () + ;; Resignal a reader error, but allow the user to replace + ;; overflow with another value. + (restart-overflow (signum number) (signum divisor) + float-format stream)) (error () (%reader-error stream _"Number not representable as a ~S: ~S" float-format (read-buffer-to-string))))))
- (defun make-ratio (stream) ;;assume *read-buffer* contains a legal ratio. Build the number from ;;the string.
===================================== src/general-info/release-21f.md ===================================== @@ -66,6 +66,7 @@ public domain. * ~~#288~~ Re-enable `deftransform` for random integers. * ~~#290~~ Pprint `with-float-traps-masked` better * ~~#291~~ Pprint `handler-case` neatly. + * ~~#293~~ Allow restarts for FP overflow in reader. * ~~#297~~ Pprint `new-assem:assemble` with less indentation. * Other changes: * Improvements to the PCL implementation of CLOS:
===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8749,6 +8749,10 @@ msgstr "" msgid "Internal error in floating point reader." msgstr ""
+#: src/code/reader.lisp +msgid "Floating-point overflow reading ~S: ~S" +msgstr "" + #: src/code/reader.lisp msgid "Floating point underflow when reading ~S: ~S" msgstr ""
===================================== tests/float.lisp ===================================== @@ -287,4 +287,49 @@ (invoke-restart 'lisp::continue)))) (read-from-string string)))))))
+(define-test fp-overflow-restarts.infinity + (:tag :issues) + ;; Test that the "infinity" restart from reader on floating-point + ;; overflow returns an infinity of the correct type and sign. + (dolist (item (list (list "4e38" ext:single-float-positive-infinity) + (list "-4e38" ext:single-float-negative-infinity) + (list "2d308" ext:double-float-positive-infinity) + (list "-2d308" ext:double-float-negative-infinity) + ;; These test the short-cut case in the reader for + ;; very large numbers. + (list "4e999" ext:single-float-positive-infinity) + (list "-4e999" ext:single-float-negative-infinity) + (list "1d999" ext:double-float-positive-infinity) + (list "-1d999" ext:double-float-negative-infinity))) + (destructuring-bind (string expected-result) + item + (assert-equal expected-result + (values (handler-bind ((reader-error + (lambda (c) + (declare (ignore c)) + (invoke-restart 'lisp::infinity)))) + (read-from-string string)))))))
+(define-test fp-overflow-restarts.huge + (:tag :issues) + ;; Test that the "largest-float" restart from reader on + ;; floating-point overflow returns the largest float of the correct + ;; type and sign. + (dolist (item (list (list "4e38" most-positive-single-float) + (list "-4e38" most-negative-single-float) + (list "2d308" most-positive-double-float) + (list "-2d308" most-negative-double-float) + ;; These test the short-cut case in the reader for + ;; very large numbers. + (list "4e999" most-positive-single-float) + (list "-4e999" most-negative-single-float) + (list "1d999" most-positive-double-float) + (list "-1d999" most-negative-double-float))) + (destructuring-bind (string expected-result) + item + (assert-equal expected-result + (handler-bind ((reader-error + (lambda (c) + (declare (ignore c)) + (values (invoke-restart 'lisp::largest-float))))) + (read-from-string string))))))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/07c9c06b3d8f1c2f7072c9c...