Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/compiler/float-tran.lisp
    ... ... @@ -347,25 +347,25 @@
    347 347 
     ;;;
    348 348
    349 349 
     (deftype single-float-exponent ()
    350 
    -  `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias
    351 
    -		vm:single-float-digits)
    350 
    +  `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias
    351 
    +		 vm:single-float-digits))
    352 352 
     	    ,(- vm:single-float-normal-exponent-max vm:single-float-bias)))
    353 353
    354 354 
     (deftype double-float-exponent ()
    355 
    -  `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias
    356 
    -		vm:double-float-digits)
    355 
    +  `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias
    356 
    +		 vm:double-float-digits))
    357 357 
     	    ,(- vm:double-float-normal-exponent-max vm:double-float-bias)))
    358 358
    359 359
    360 360 
     (deftype single-float-int-exponent ()
    361 
    -  `(integer ,(- vm:single-float-normal-exponent-min vm:single-float-bias
    362 
    -		(* vm:single-float-digits 2))
    361 
    +  `(integer (,(- vm:single-float-normal-exponent-min vm:single-float-bias
    362 
    +		 (* vm:single-float-digits 2)))
    363 363 
     	    ,(- vm:single-float-normal-exponent-max vm:single-float-bias
    364 364 
     		vm:single-float-digits)))
    365 365
    366 366 
     (deftype double-float-int-exponent ()
    367 
    -  `(integer ,(- vm:double-float-normal-exponent-min vm:double-float-bias
    368 
    -		(* vm:double-float-digits 2))
    367 
    +  `(integer (,(- vm:double-float-normal-exponent-min vm:double-float-bias
    368 
    +		 (* vm:double-float-digits 2)))
    369 369 
     	    ,(- vm:double-float-normal-exponent-max vm:double-float-bias
    370 370 
     		vm:double-float-digits)))
    371 371

  • tests/issues.lisp
    ... ... @@ -840,3 +840,60 @@
    840 840 
       (let ((f (compile nil #'(lambda ()
    841 841 
     			    (nth-value 1 (integer-decode-float least-positive-double-float))))))
    842 842 
         (assert-equal -1126 (funcall f))))
    843 
    +
    844 
    +
    845 
    +
    846 
    +(define-test issue.167.single
    847 
    +    (:tag :issues)
    848 
    +  (let ((df-min-expo (nth-value 1 (decode-float least-positive-single-float)))
    849 
    +	(df-max-expo (nth-value 1 (decode-float most-positive-single-float))))
    850 
    +    ;; Verify that the min exponent for kernel:single-float-exponent
    851 
    +    ;; is the actual min exponent from decode-float.
    852 
    +    (assert-true (typep df-min-expo 'kernel:single-float-exponent))
    853 
    +    (assert-true (typep (1+ df-min-expo) 'kernel:single-float-exponent))
    854 
    +    (assert-false (typep (1- df-min-expo) 'kernel:single-float-exponent))
    855 
    +
    856 
    +    ;; Verify that the max exponent for kernel:single-float-exponent
    857 
    +    ;; is the actual max exponent from decode-float.
    858 
    +    (assert-true (typep df-max-expo 'kernel:single-float-exponent))
    859 
    +    (assert-true (typep (1- df-max-expo) 'kernel:single-float-exponent))
    860 
    +    (assert-false (typep (1+ df-max-expo) 'kernel:single-float-exponent)))
    861 
    +
    862 
    +  ;; Same as for decode-float, but for integer-decode-float.
    863 
    +  (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-single-float)))
    864 
    +	(idf-max-expo (nth-value 1 (integer-decode-float most-positive-single-float))))
    865 
    +    (assert-true (typep idf-min-expo 'kernel:single-float-int-exponent))
    866 
    +    (assert-true (typep (1+ idf-min-expo) 'kernel:single-float-int-exponent))
    867 
    +    (assert-false (typep (1- idf-min-expo) 'kernel:single-float-int-exponent))
    868 
    +
    869 
    +    (assert-true (typep idf-max-expo 'kernel:single-float-int-exponent))
    870 
    +    (assert-true (typep (1- idf-max-expo) 'kernel:single-float-int-exponent))
    871 
    +    (assert-false (typep (1+ idf-max-expo) 'kernel:single-float-int-exponent))))
    872 
    +
    873 
    +(define-test issue.167.double
    874 
    +    (:tag :issues)
    875 
    +  (let ((df-min-expo (nth-value 1 (decode-float least-positive-double-float)))
    876 
    +	(df-max-expo (nth-value 1 (decode-float most-positive-double-float))))
    877 
    +    ;; Verify that the min exponent for kernel:double-float-exponent
    878 
    +    ;; is the actual min exponent from decode-float.
    879 
    +    (assert-true (typep df-min-expo 'kernel:double-float-exponent))
    880 
    +    (assert-true (typep (1+ df-min-expo) 'kernel:double-float-exponent))
    881 
    +    (assert-false (typep (1- df-min-expo) 'kernel:double-float-exponent))
    882 
    +
    883 
    +    ;; Verify that the max exponent for kernel:double-float-exponent
    884 
    +    ;; is the actual max exponent from decode-float.
    885 
    +    (assert-true (typep df-max-expo 'kernel:double-float-exponent))
    886 
    +    (assert-true (typep (1- df-max-expo) 'kernel:double-float-exponent))
    887 
    +    (assert-false (typep (1+ df-max-expo) 'kernel:double-float-exponent)))
    888 
    +
    889 
    +  ;; Same as for decode-float, but for integer-decode-float.
    890 
    +  (let ((idf-min-expo (nth-value 1 (integer-decode-float least-positive-double-float)))
    891 
    +	(idf-max-expo (nth-value 1 (integer-decode-float most-positive-double-float))))
    892 
    +    (assert-true (typep idf-min-expo 'kernel:double-float-int-exponent))
    893 
    +    (assert-true (typep (1+ idf-min-expo) 'kernel:double-float-int-exponent))
    894 
    +    (assert-false (typep (1- idf-min-expo) 'kernel:double-float-int-exponent))
    895 
    +
    896 
    +    (assert-true (typep idf-max-expo 'kernel:double-float-int-exponent))
    897 
    +    (assert-true (typep (1- idf-max-expo) 'kernel:double-float-int-exponent))
    898 
    +    (assert-false (typep (1+ idf-max-expo) 'kernel:double-float-int-exponent))))
    899 
    +

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help