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 a test for :interpreter

Browse source
This commit is contained in:
Stas Boukarev 2026-07-30 01:02:18 +03:00
parent a56065fe38
commit ff3913b277
1 changed files with 22 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
tests/jump-table.pure.lisp
View file

@ -197,24 +197,26 @@
standard-char)
p1))))
(defun good-example (x y)
(declare (fixnum x))
(let ((bits (logand x 7)))
(case bits
(0 (print 'foo))
(1 (cons 'a y))
(2 (cons y 'zook))
(3 "hi"))))
(defun failing-example (x y)
(declare (fixnum x))
(let ((bits (logand x 3)))
(case bits
(0 (print 'foo))
(1 (cons 'a y))
(2 (cons y 'zook))
(3 "hi"))))
(with-test (:name :should-use-jump-table)
(assert (= (sb-kernel:code-jump-table-words (sb-kernel:fun-code-header #'good-example)) 5))
(assert (= (sb-kernel:code-jump-table-words (sb-kernel:fun-code-header #'failing-example)) 5)))
(assert (= (sb-kernel:code-jump-table-words
(sb-kernel:fun-code-header
(checked-compile `(lambda (x y)
(declare (fixnum x))
(let ((bits (logand x 7)))
(case bits
(0 (print 'foo))
(1 (cons 'a y))
(2 (cons y 'zook))
(3 "hi")))))))
5))
(assert (= (sb-kernel:code-jump-table-words
(sb-kernel:fun-code-header
(checked-compile `(lambda (x y)
(declare (fixnum x))
(let ((bits (logand x 3)))
(case bits
(0 (print 'foo))
(1 (cons 'a y))
(2 (cons y 'zook))
(3 "hi")))))))
5)))