common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Fix float zero type unparsing

Browse source 
Fixes lp#2137140
This commit is contained in:
Stas Boukarev 2025-12-26 20:19:25 +03:00
parent 7d8d9260ff
commit 3f823e43dc
2 changed files with 19 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
src/code/type.lisp
View file

@ -4627,7 +4627,7 @@ expansion happened."
(high (numeric-type-high single)))
(labels ((n= (x y)
(and (not (float-infinity-or-nan-p x))
(sb-xc:= x y)))
(fp= x y)))
(match (x y)
;; equalp doesn't work on floats in sb-xc-host
(cond ((null x)
@ -5966,6 +5966,18 @@ expansion happened."
(t
(sb-xc:<= a b))))
(defun fp= (a b)
(cond ((or (eql a -0f0)
(eql a -0d0))
(or (eql b -0f0)
(eql b -0d0)))
((or (eql a 0f0)
(eql a 0d0))
(or (eql b 0f0)
(eql b 0d0)))
(t
(sb-xc:= a b))))
(defun low-le-low-p (a b)
(cond ((not a)
t)

6
tests/type.pure.lisp
View file

@ -1259,3 +1259,9 @@
(specifier-type '(and number (not double-float)))))
(assert (eq (specifier-type '(or real complex))
(specifier-type 'number))))
(with-test (:name :float-zero-unparse)
(assert (member (type-specifier (specifier-type (opaque-identity '(member 0.0d0 -0.0))))
'((or (member 0.0d0) (member -0.0))
(or (member -0.0) (member 0.0d0)))
:test #'equal)))