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

Redo a test without using threads

Browse source
This commit is contained in:
Stas Boukarev 2026-09-01 00:17:56 +03:00
parent 17d379157f
commit 1dc3d56d15
1 changed files with 10 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
tests/mv-return.impure.lisp
View file

@ -9,20 +9,16 @@
(defun ret2 ()
(values 1 2 3 4))
(sb-ext:schedule-timer (make-timer (lambda () (ret2))) 0.1
:repeat-interval 0.005)
(defglobal *stop* nil)
(defun j ()
(loop
(when *stop* (return))
(ret2)
(assert (not (mismatch (multiple-value-list (ret))
'#.(loop for i below mvl collect (list i))
:test #'equal)))))
(let ((end (+ (get-internal-real-time)
(* internal-time-units-per-second #-slow 1/2))))
(loop until (>= (get-internal-real-time) end)
do
(ret2)
(assert (not (mismatch (multiple-value-list (ret))
'#.(loop for i below mvl collect (list i))
:test #'equal))))))
(test-util:with-test (:name :async-mv-area-preservation)
(let ((thr (sb-thread:make-thread #'j)))
(sleep .75)
(setq *stop* t)
(sb-thread:join-thread thr)))
(schedule-timer (make-timer (lambda () (ret2))) 0.1 :repeat-interval 0.005)
(j))