[Git][cmucl/cmucl][master] 2 commits: Fix #167: double-float-exponent off by one

[Raymond Toy (@rtoy)]

Raymond Toy pushed to branch master at cmucl / cmucl


Commits:
eb943b50 by Raymond Toy at 2023-02-28T15:50:59+00:00
Fix #167: double-float-exponent off by one

- - - - -
6ba270b2 by Raymond Toy at 2023-02-28T15:51:05+00:00
Merge branch 'issue-167-exponent-bounds-off-by-one' into 'master'

Fix #167: double-float-exponent off by one

See merge request cmucl/cmucl!121
- - - - -


2 changed files:

- src/compiler/float-tran.lisp
- tests/issues.lisp


Changes:

=====================================
src/compiler/float-tran.lisp
=====================================
@@ -347,25 +347,25 @@
 ;;;
 
 (deftype single-float-exponent ()
-  `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias
-		vm:single-float-digits)
+  `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias
+		 vm:single-float-digits))
 	    ,(- vm:single-float-normal-exponent-max vm:single-float-bias)))
 
 (deftype double-float-exponent ()
-  `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias
-		vm:double-float-digits)
+  `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias
+		 vm:double-float-digits))
 	    ,(- vm:double-float-normal-exponent-max vm:double-float-bias)))
 
 
 (deftype single-float-int-exponent ()
-  `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias
-		(* vm:single-float-digits 2))
+  `(integer (,(- 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
 		vm:single-float-digits)))
 
 (deftype double-float-int-exponent ()
-  `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias
-		(* vm:double-float-digits 2))
+  `(integer (,(- 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
 		vm:double-float-digits)))
 


=====================================
tests/issues.lisp
=====================================
@@ -840,3 +840,60 @@
   (let ((f (compile nil #'(lambda ()
 			    (nth-value 1 (integer-decode-float least-positive-double-float))))))
     (assert-equal -1126 (funcall f))))
+
+
+
+(define-test issue.167.single
+    (:tag :issues)
+  (let ((df-min-expo (nth-value 1 (decode-float least-positive-single-float)))
+	(df-max-expo (nth-value 1 (decode-float most-positive-single-float))))
+    ;; Verify that the min exponent for kernel:single-float-exponent
+    ;; is the actual min exponent from decode-float.
+    (assert-true (typep df-min-expo 'kernel:single-float-exponent))
+    (assert-true (typep (1+ df-min-expo) 'kernel:single-float-exponent))
+    (assert-false (typep (1- df-min-expo) 'kernel:single-float-exponent))
+
+    ;; Verify that the max exponent for kernel:single-float-exponent
+    ;; is the actual max exponent from decode-float.
+    (assert-true (typep df-max-expo 'kernel:single-float-exponent))
+    (assert-true (typep (1- df-max-expo) 'kernel:single-float-exponent))
+    (assert-false (typep (1+ df-max-expo) 'kernel:single-float-exponent)))
+
+  ;; Same as for decode-float, but for integer-decode-float.
+  (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-single-float)))
+	(idf-max-expo (nth-value 1 (integer-decode-float most-positive-single-float))))
+    (assert-true (typep idf-min-expo 'kernel:single-float-int-exponent))
+    (assert-true (typep (1+ idf-min-expo) 'kernel:single-float-int-exponent))
+    (assert-false (typep (1- idf-min-expo) 'kernel:single-float-int-exponent))
+
+    (assert-true (typep idf-max-expo 'kernel:single-float-int-exponent))
+    (assert-true (typep (1- idf-max-expo) 'kernel:single-float-int-exponent))
+    (assert-false (typep (1+ idf-max-expo) 'kernel:single-float-int-exponent))))
+
+(define-test issue.167.double
+    (:tag :issues)
+  (let ((df-min-expo (nth-value 1 (decode-float least-positive-double-float)))
+	(df-max-expo (nth-value 1 (decode-float most-positive-double-float))))
+    ;; Verify that the min exponent for kernel:double-float-exponent
+    ;; is the actual min exponent from decode-float.
+    (assert-true (typep df-min-expo 'kernel:double-float-exponent))
+    (assert-true (typep (1+ df-min-expo) 'kernel:double-float-exponent))
+    (assert-false (typep (1- df-min-expo) 'kernel:double-float-exponent))
+
+    ;; Verify that the max exponent for kernel:double-float-exponent
+    ;; is the actual max exponent from decode-float.
+    (assert-true (typep df-max-expo 'kernel:double-float-exponent))
+    (assert-true (typep (1- df-max-expo) 'kernel:double-float-exponent))
+    (assert-false (typep (1+ df-max-expo) 'kernel:double-float-exponent)))
+
+  ;; Same as for decode-float, but for integer-decode-float.
+  (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-double-float)))
+	(idf-max-expo (nth-value 1 (integer-decode-float most-positive-double-float))))
+    (assert-true (typep idf-min-expo 'kernel:double-float-int-exponent))
+    (assert-true (typep (1+ idf-min-expo) 'kernel:double-float-int-exponent))
+    (assert-false (typep (1- idf-min-expo) 'kernel:double-float-int-exponent))
+
+    (assert-true (typep idf-max-expo 'kernel:double-float-int-exponent))
+    (assert-true (typep (1- idf-max-expo) 'kernel:double-float-int-exponent))
+    (assert-false (typep (1+ idf-max-expo) 'kernel:double-float-int-exponent))))
+    



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/797e2e1711282e1b5316838613123305f5917e1a...6ba270b2d4b70c37d4bd3628bedc18c14043b51a

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/797e2e1711282e1b5316838613123305f5917e1a...6ba270b2d4b70c37d4bd3628bedc18c14043b51a
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230228/e99cb52f/attachment-0001.html>