GitLab

at 2024-04-10T08:12:12-07:00

Add test reading denormals with underflow enabled.

We should be able to read denormals without problems even if FP
underflow is enabled.

Fix underflow test that was underflowing

In the test, we had underflow enabled, but computed numbers that would
underflow.  Hence, only wrap the part that reads floats with underflow
enabled.

Just enable underflow only around reading from the string

Handle underflow for very tiny numbers

Previously, when the numbers were very tiny, we signaled a
reader-error but didn't have a restart to return 0.  Modify the code
so that when we have very tiny numbers, we signal a
`floating-point-underflow` error that we can catch and establish a
restart to return 0.

For very large numbers that overflow, we just signal a reader-error
for now.

Update cmucl.pot too for the new string.

   ;; throw an error immediately.  We don't need to be super accurate

   ;; with the limits.  The rest of the code will handle it correctly,

   ;; even if we're too small or too large.

-  (unless (zerop number)

-    (flet ((fast-log2 (n)

-             ;;  For an integer, the integer-length is close enough to

-             ;;  the log2 of the number.

-             (integer-length n)))

-      ;; log2(x) = log(number*10^exponent/divisor)

-      ;;         = exponent*log2(10) + log2(number)-log2(divisor)

-      (let ((log2-num (+ (* exponent #.(kernel::log2 10d0))

-                         (fast-log2 number)

-                         (- (fast-log2 divisor)))))

-        (multiple-value-bind (log2-low log2-high)

-            (ecase float-format

-              ((short-float single-float)

-               ;; Single-float exponents range is -149 to 127, but we

-               ;; don't need to be super-accurate since we're

-               ;; multiplying the values by 2.

-               (values (* 2 (- vm:single-float-normal-exponent-min

-                               vm:single-float-bias

-                               vm:single-float-digits))

-                       (* 2 (- vm:single-float-normal-exponent-max

-                               vm:single-float-bias))))

-              ((double-float long-float

-                             #+double-double kernel:double-double-float)

-               ;; Double-float exponent range is -1074 to -1023

-               (values (* 2 (- vm:double-float-normal-exponent-min

-                               vm:double-float-bias

-                               vm:double-float-digits))

-                       (* 2 (- vm:double-float-normal-exponent-max

-                               vm:double-float-bias)))))

-          (unless (< log2-low log2-num log2-high)

-            ;; The number is definitely too large or too small to fit.

-            ;; Signal an error.

-            (%reader-error stream _"Number not representable as a ~S: ~S"

-			   float-format (read-buffer-to-string)))))))

-

-  ;; Otherwise the number might fit, so we carefully compute the result.

-  (handler-case

-      (with-float-traps-masked (:underflow)

-        (let* ((ratio (/ (* (expt 10 exponent) number)

-                         divisor))

-	       (result (coerce ratio float-format)))

-	  (when (and (zerop result) (not (zerop number)))

-	    ;; The number we've read is so small that it gets

-	    ;; converted to 0.0, but is not actually zero.  Signal an

-	    ;; error.  See CLHS 2.3.1.1.

-            (error 'floating-point-underflow))

-          result))

-    (floating-point-underflow ()

-      ;; Resignal a reader error, but allow the user to continue with

-      ;; 0.

-      (let ((zero (coerce 0 float-format)))

-        (restart-case

-            (%reader-error stream _"Floating point underflow when reading ~S: ~S"

-                           float-format (read-buffer-to-string))

-          (continue ()

-            :report (lambda (stream)

-                      (format stream "Return ~A" zero))

-            zero))))

-    (error ()

-	   (%reader-error stream _"Number not representable as a ~S: ~S"

-			  float-format (read-buffer-to-string)))))

+  (flet ((handle-extreme-numbers ()

+           (unless (zerop number)

+             (flet ((fast-log2 (n)

+                      ;;  For an integer, the integer-length is close enough to

+                      ;;  the log2 of the number.

+                      (integer-length n)))

+               ;; log2(x) = log(number*10^exponent/divisor)

+               ;;         = exponent*log2(10) + log2(number)-log2(divisor)

+               (let ((log2-num (+ (* exponent #.(kernel::log2 10d0))

+                                  (fast-log2 number)

+                                  (- (fast-log2 divisor)))))

+                 (multiple-value-bind (log2-low log2-high)

+                     (ecase float-format

+                       ((short-float single-float)

+                        ;; Single-float exponents range is -149 to 127, but we

+                        ;; don't need to be super-accurate since we're

+                        ;; multiplying the values by 2.

+                        (values (* 2 (- vm:single-float-normal-exponent-min

+                                        vm:single-float-bias

+                                        vm:single-float-digits))

+                                (* 2 (- vm:single-float-normal-exponent-max

+                                        vm:single-float-bias))))

+                       ((double-float long-float

+                                      #+double-double kernel:double-double-float)

+                        ;; Double-float exponent range is -1074 to -1023

+                        (values (* 2 (- vm:double-float-normal-exponent-min

+                                        vm:double-float-bias

+                                        vm:double-float-digits))

+                                (* 2 (- vm:double-float-normal-exponent-max

+                                        vm:double-float-bias)))))

+                   (when (<= log2-num log2-low)

+                     ;; Number is definitely too small; signal an underflow.

+                     (error 'floating-point-underflow))

+                   (when (>= log2-num log2-high)

+                     ;; Number is definitely too large; signal an error

+                     (error "Overflow"))))))))

+

+    ;; Otherwise the number might fit, so we carefully compute the result.

+    (handler-case

+        (with-float-traps-masked (:underflow)

+          (handle-extreme-numbers)

+          (let* ((ratio (/ (* (expt 10 exponent) number)

+                           divisor))

+	         (result (coerce ratio float-format)))

+	    (when (and (zerop result) (not (zerop number)))

+	      ;; The number we've read is so small that it gets

+	      ;; converted to 0.0, but is not actually zero.  Signal an

+	      ;; error.  See CLHS 2.3.1.1.

+              (error 'floating-point-underflow))

+            result))

+      (floating-point-underflow ()

+        ;; Resignal a reader error, but allow the user to continue with

+        ;; 0.

+        (let ((zero (coerce 0 float-format)))

+          (restart-case

+              (%reader-error stream _"Floating point underflow when reading ~S: ~S"

+                             float-format (read-buffer-to-string))

+            (continue ()

+              :report (lambda (stream)

+                        (format stream "Return ~A" zero))

+              zero))))

+      (error ()

+	(%reader-error stream _"Number not representable as a ~S: ~S"

+		       float-format (read-buffer-to-string))))))

 (defun make-ratio (stream)

 msgstr ""

 #: src/code/reader.lisp

-msgid "Number not representable as a ~S: ~S"

+msgid "Floating point underflow when reading ~S: ~S"

 msgstr ""

 #: src/code/reader.lisp

-msgid "Floating point underflow when reading ~S: ~S"

+msgid "Number not representable as a ~S: ~S"

 msgstr ""

 #: src/code/reader.lisp

     (assert-equal 0.9999999999999999d0

                   (rounding-test 3d0))))

+(define-test reader.underflow-enabled

+    (:tag :issues)

+  ;; Test with FP underflow enabled, we can still read denormals

+  ;; without problem.  For this test we only care that we get a

+  ;; number, not the actual value.

+  (dolist (n (list least-positive-single-float

+                   least-positive-normalized-single-float

+                   (/ (+ least-positive-single-float

+                         least-positive-normalized-single-float)

+                      2)

+                   least-positive-double-float

+                   least-positive-normalized-double-float

+                   (/ (+ least-positive-double-float

+                         least-positive-normalized-double-float)

+                      2)

+                   ))

+    (assert-true (floatp

+                  (ext:with-float-traps-enabled (:underflow)

+                    (read-from-string (format nil "~A" n)))))))

+

+(define-test reader-restarts.underflow

+    (:tag :issues)

+  ;; Test that we get a restart when reading floating-point numbers

+  ;; that are too small to fit in a float.  Invoke the restart to

+  ;; return 0.  All the numbers must be less than half the

+  ;; leasst-positive float.

+  (dolist (item '(("1e-46" 0f0)

+                  ("1e-999" 0f0)

+                  ("1d-324" 0d0)

+                  ("1d-999" 0d0)))

+    (destructuring-bind (string expected-value)

+        item

+      (assert-equal expected-value

+                    (values (handler-bind

+                                ((reader-error

+                                   (lambda (c)

+                                     (declare (ignore c))

+                                     (invoke-restart 'lisp::continue))))

+                              (read-from-string string)))))))

+   

+

Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl

Commits:

3 changed files:

Changes: