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

constant-lvar-p: always check the type.

Browse source 
lvar-reoptimize might not go deep enough.

Fixes lp#2129549
This commit is contained in:
Stas Boukarev 2025-10-22 17:28:04 +03:00
parent a8e57f2e3e
commit 163dbb1623
4 changed files with 9 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
contrib/sb-concurrency/tests/test-frlock.lisp
View file

@ -83,7 +83,7 @@
#+sb-thread
(deftest frlock.1
(handler-case
(sb-ext:with-timeout #+gc-stress 400
(sb-ext:with-timeout (* 40 #+gc-stress 10)
(test-frlocks #+win32 :outer-write-pause #+win32 t ))
(sb-ext:timeout (c)
(error "~A" c)))

2
src/code/target-signal.lisp
View file

@ -276,7 +276,7 @@
(collect ((result))
(dotimes (i 32 (result))
(when (logbitp i mask)
(result (alien-funcall
(result (alien-funcall
(eval '(extern-alien "sigabbrev_np" (function c-string int))) ;; might not exist
(1+ i)))))))
(defun show-sigmasks (&aux (first t))

10
src/compiler/ir1opt.lisp
View file

@ -34,10 +34,9 @@
;; later turn out to be of the wrong type.
;; And ir1-transforms suffer from this because
;; they expect LVAR-VALUE to be of a restricted type.
(or (not (lvar-reoptimize principal-lvar))
(or (ctypep (constant-value leaf) type)
;; Don't return T for type-singleton-p, it may still mismatch.
(return-from constant-lvar-p))))
(or (ctypep (constant-value leaf) type)
;; Don't return T for type-singleton-p, it may still mismatch.
(return-from constant-lvar-p)))
;; check for EQL types and singleton numeric types
(values (type-singleton-p type)))))
@ -51,8 +50,7 @@
leaf)
(when (ref-p principal-use)
(if (constant-p (setf leaf (ref-leaf principal-use)))
(when (or (not (lvar-reoptimize principal-lvar))
ignore-types
(when (or ignore-types
(ctypep (constant-value leaf) type))
leaf)
(process-lvar (lambda-var-ref-lvar principal-use))))))))

3
tests/test-util.lisp
View file

@ -2,6 +2,9 @@
(sb-thread:make-thread (lambda ()
(loop (gc :full t) (sleep 0.001)))
:name "gc stress")
#+slow
(setf (sb-alien:extern-alien "verify_gens" char) 0
(extern-alien "pre_verify_gen_0" int) 1)
(defpackage :test-util
(:use :cl :sb-ext)