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

Make 2 tests more self-contained

Browse source
This commit is contained in:
Douglas Katzman 2020-09-20 02:25:00 -04:00
parent ec72653e89
commit 86424fee2d
2 changed files with 8 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
tests/aprof.impure.lisp
View file

@ -11,19 +11,21 @@
#-(and x86-64 sb-thread) (sb-ext:exit :code 104) ;; not implemented elsewhere
(defstruct fruitbasket x y z)
(with-test (:name :aprof-smoketest-struct
:skipped-on :darwin
;; reverse-engineering the allocation instructions fails but should not
:fails-on (not :immobile-space))
(let ((nbytes
(sb-aprof:aprof-run
(checked-compile
'(sb-int:named-lambda "test" ()
(declare (inline sb-thread:make-mutex)
(declare (inline make-fruitbasket)
(optimize sb-c::instrument-consing))
(loop repeat 50 collect (sb-thread:make-mutex))))
(loop repeat 50 collect (make-fruitbasket))))
:stream nil)))
(assert (= nbytes
(* 50 (+ (sb-vm::primitive-object-size (sb-thread:make-mutex))
(* 50 (+ (sb-vm::primitive-object-size (make-fruitbasket))
(* 2 sb-vm:n-word-bytes))))))) ; cons cells
(with-test (:name :aprof-smoketest-non-constant-size-vector

4
tests/constantp.pure.lisp
View file

@ -13,6 +13,7 @@
:allow-failure t)))
(assert (not (constantp '(block 1 10)))))
(sb-ext:defglobal *some-global-var* nil)
(with-test (:name (constantp progv))
(assert
(not (constantp '(progv '(*s*) nil *s*))))
@ -31,8 +32,9 @@
(assert
(not (constantp '(progv '(pi) '(10) 10))))
(assert
(not (constantp '(progv '(sb-c::**world-lock**) '(10) 10)))))
(not (constantp '(progv '(*some-global-var*) '(10) 10)))))
(declaim (muffle-conditions style-warning)) ; unknown type ABC
(with-test (:name (constantp the))
(assert
(not (constantp '(the (satisfies eval) 10))))