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 (/ real complex) float contagion

Browse source
This commit is contained in:
Stas Boukarev 2026-02-13 01:24:27 +03:00
parent d44029f2dd
commit f96e614006
4 changed files with 16 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/compiler/float-tran.lisp
View file

@ -1457,12 +1457,12 @@
(if (vop-existsp :translate sb-vm::swap-complex)
(let ((real (csubtypep (lvar-type x) (specifier-type 'real))))
`(let* (,@(if real
'((x (coerce x ',type))))
'((x (coerce x 'float))))
(cs ,(if real
'(complex ,(coerce 0 type) (%negate x))
'(complex 0 (%negate x))
'(conjugate (sb-vm::swap-complex x))))
,@(if real
'((x (complex x ,(coerce 0 type)))))
'((x (complex x 0))))
(ry (realpart y))
(iy (imagpart y)))
(if (> (abs ry) (abs iy))

8
tests/arith-2.pure.lisp
View file

@ -2412,7 +2412,13 @@
(/ (- a) (- b)))
((#c(0.0 3.0) #c(0.0 3.0))
(/ (opaque-identity (- #c(0.0 3.0)))
(opaque-identity (- #c(0.0 3.0)))))))
(opaque-identity (- #c(0.0 3.0))))))
(checked-compile-and-assert
()
`(lambda (n)
(declare (double-float n))
(/ n #C(1.0 2.0)))
((5d0) #C(1.0d0 -2.0d0))))
(with-test (:name :truncate+/+complex)
(checked-compile-and-assert

6
tests/parallel-exec.lisp
View file

@ -1,6 +1,10 @@
(pop *posix-argv*)
(require :sb-posix)
#-sparc (push :test-sprof *features*)
(if (find "--no-sprof" *posix-argv* :test #'equal)
(setf *posix-argv* (remove "--no-sprof" *posix-argv* :test #'equal))
#-sparc (push :test-sprof *features*))
#+test-sprof (require :sb-sprof)
;; (push :tlsf-stress *features*)