Skip to content
Snippets Groups Projects
Commit ebc07aeb authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix ticket 93.

 * src/code/reader.lisp:
   * Try to round really small numbers
   * Add somewhat more informative message when the number is not
     representable.
 * src/i18n/local/cmucl.pot:
   * Update
 * tests/trac.lisp:
   * Add test for ticket 93
   * Add a few comments for test trac.87.
parent 0e94b217
No related branches found
No related tags found
No related merge requests found
...@@ -1824,17 +1824,31 @@ the end of the stream." ...@@ -1824,17 +1824,31 @@ the end of the stream."
(defun make-float-aux (number divisor float-format stream) (defun make-float-aux (number divisor float-format stream)
(handler-case (handler-case
(with-float-traps-masked (:underflow) (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))) (when (and (zerop result) (not (zerop number)))
;; With underflow traps disabled, reading any number ;; The number we've read is so small that it gets
;; smaller than least-positive-foo-float will return zero. ;; converted to 0.0, but is not actually zero. In this
;; But we really want to indicate that we can't read it. ;; case, we want to round such small numbers to
;; So if we converted the number to zero, but the number ;; least-positive-foo-float. If it's still too small, we
;; wasn't actually zero, throw an error. ;; want to signal an error saying that we can't really
(error _"Underflow")) ;; 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)) result))
(error () (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) (defun make-ratio (stream)
......
...@@ -182,9 +182,9 @@ msgid "" ...@@ -182,9 +182,9 @@ msgid ""
" setf." " setf."
msgstr "" msgstr ""
   
#: src/code/format.lisp src/code/print.lisp src/code/irrat-dd.lisp #: src/code/reader.lisp src/code/format.lisp src/code/print.lisp
#: src/code/irrat.lisp src/code/float.lisp src/code/numbers.lisp #: src/code/irrat-dd.lisp src/code/irrat.lisp src/code/float.lisp
#: src/code/kernel.lisp #: src/code/numbers.lisp src/code/kernel.lisp
msgid "Argument ~A is not a ~S: ~S." msgid "Argument ~A is not a ~S: ~S."
msgstr "" msgstr ""
   
...@@ -8553,7 +8553,7 @@ msgid "Underflow" ...@@ -8553,7 +8553,7 @@ msgid "Underflow"
msgstr "" msgstr ""
   
#: src/code/reader.lisp #: src/code/reader.lisp
msgid "Floating-point number not representable" msgid "Number not representable as ~S: ~S"
msgstr "" msgstr ""
   
#: src/code/reader.lisp #: src/code/reader.lisp
...@@ -13084,7 +13084,11 @@ msgid "" ...@@ -13084,7 +13084,11 @@ msgid ""
" process changes. The function takes the process as an argument.\n" " process changes. The function takes the process as an argument.\n"
" :external-format -\n" " :external-format -\n"
" This is the external-format used for communication with the subproce" " 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 "" msgstr ""
   
#: src/code/run-program.lisp #: src/code/run-program.lisp
......
...@@ -276,7 +276,9 @@ ...@@ -276,7 +276,9 @@
(define-test trac.87.output (define-test trac.87.output
(:tag :trac) (: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")) (string "Hello"))
(unwind-protect (unwind-protect
(progn (progn
...@@ -297,7 +299,9 @@ ...@@ -297,7 +299,9 @@
(define-test trac.87.input (define-test trac.87.input
(:tag :trac) (: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")) (string "Hello"))
(unwind-protect (unwind-protect
(progn (progn
...@@ -328,3 +332,23 @@ ...@@ -328,3 +332,23 @@
'double-float 'double-float
(third (kernel:%function-type f))))) (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
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment