diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 4eabc4e13ccb7d2cb2db0e9bd2da88e264eff317..27c18ae3402e2a3a933db466bc21227c62575d08 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -1824,17 +1824,31 @@ the end of the stream." (defun make-float-aux (number divisor float-format stream) (handler-case (with-float-traps-masked (:underflow) - (let ((result (coerce (/ number divisor) float-format))) + (let* ((ratio (/ number divisor)) + (result (coerce ratio float-format))) (when (and (zerop result) (not (zerop number))) - ;; With underflow traps disabled, reading any number - ;; smaller than least-positive-foo-float will return zero. - ;; But we really want to indicate that we can't read it. - ;; So if we converted the number to zero, but the number - ;; wasn't actually zero, throw an error. - (error _"Underflow")) + ;; The number we've read is so small that it gets + ;; converted to 0.0, but is not actually zero. In this + ;; case, we want to round such small numbers to + ;; least-positive-foo-float. If it's still too small, we + ;; want to signal an error saying that we can't really + ;; convert it because the exponent is too small. + ;; See CLHS 2.3.1.1. + (let ((float-limit (ecase float-format + ((short-float single-float) + least-positive-single-float) + (double-float + least-positive-double-float) + (double-double-float + (kernel:make-double-double-float least-positive-double-float + 0d0))))) + (if (>= (* 2 ratio) float-limit) + (setf result float-limit) + (error _"Underflow")))) result)) (error () - (%reader-error stream _"Floating-point number not representable")))) + (%reader-error stream _"Number not representable as ~S: ~S" + float-format (/ number divisor))))) (defun make-ratio (stream) diff --git a/src/i18n/locale/cmucl.pot b/src/i18n/locale/cmucl.pot index 8ae0b93aaf8c9ae92c621bcaf24892144c9d797c..2034dacb69a94dbced9f2f57e2bb5dd9eb6c6282 100644 --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -182,9 +182,9 @@ msgid "" " setf." msgstr "" -#: src/code/format.lisp src/code/print.lisp src/code/irrat-dd.lisp -#: src/code/irrat.lisp src/code/float.lisp src/code/numbers.lisp -#: src/code/kernel.lisp +#: src/code/reader.lisp src/code/format.lisp src/code/print.lisp +#: src/code/irrat-dd.lisp src/code/irrat.lisp src/code/float.lisp +#: src/code/numbers.lisp src/code/kernel.lisp msgid "Argument ~A is not a ~S: ~S." msgstr "" @@ -8553,7 +8553,7 @@ msgid "Underflow" msgstr "" #: src/code/reader.lisp -msgid "Floating-point number not representable" +msgid "Number not representable as ~S: ~S" msgstr "" #: src/code/reader.lisp @@ -13084,7 +13084,11 @@ msgid "" " process changes. The function takes the process as an argument.\n" " :external-format -\n" " This is the external-format used for communication with the subproce" -"ss." +"ss.\n" +" :element-type -\n" +" When a stream is created for :input or :output, the stream\n" +" uses this element-type instead of the default 'BASE-CHAR type.\n" +"" msgstr "" #: src/code/run-program.lisp diff --git a/tests/trac.lisp b/tests/trac.lisp index 87e3ca72b0dbcc4a52770ff2880b51dd93ea036d..7fd940821f4a6bba381e4944febef1aad847673a 100644 --- a/tests/trac.lisp +++ b/tests/trac.lisp @@ -276,7 +276,9 @@ (define-test trac.87.output (:tag :trac) - (let ((path "/tmp/trac.87") + ;; Test that run-program accepts :element-type and produces the + ;; correct output. + (let ((path "/tmp/trac.87.output") (string "Hello")) (unwind-protect (progn @@ -297,7 +299,9 @@ (define-test trac.87.input (:tag :trac) - (let ((path "/tmp/trac.87") + ;; Test that run-program accepts :element-type and produces the + ;; correct input (and output). + (let ((path "/tmp/trac.87.input") (string "Hello")) (unwind-protect (progn @@ -328,3 +332,23 @@ 'double-float (third (kernel:%function-type f))))) +(define-test trac.93 + (:tag :trac) + ;; These small values should read to least-positive-foo-float + ;; because that's the closest non-zero float. + (assert-eql least-positive-short-float + (values (read-from-string ".8s-45"))) + (assert-eql least-positive-single-float + (values (read-from-string ".8e-45"))) + (assert-eql least-positive-double-float + (values (read-from-string "4d-324"))) + (assert-eql (kernel:make-double-double-float least-positive-double-float 0d0) + (values (read-from-string "4w-324"))) + ;; These should signal reader errors because the numbers are not + ;; zero, but are too small to be represented by the corresponding + ;; float type. + (assert-error 'reader-error (read-from-string ".1s-45")) + (assert-error 'reader-error (read-from-string ".1e-45")) + (assert-error 'reader-error (read-from-string "1d-324")) + (assert-error 'reader-error (read-from-string "1w-324"))) + \ No newline at end of file