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/797e2e1711282e1b5316838... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/797e2e1711282e1b5316838... You're receiving this email because of your account on gitlab.common-lisp.net.