Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • cmucl/cmucl
  • pfominykh/cmucl
  • yitzchak/cmucl
  • rkreuter/cmucl
  • cshapiro/cmucl
5 results
Show changes
Commits on Source (2)
......@@ -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)
......
......@@ -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.
......
......@@ -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:
......
......@@ -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 ""
......
......@@ -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))))))