Chez Scheme: fix race in a test

This commit is contained in:
Matthew Flatt 2020-10-23 08:28:55 -06:00
parent 614992a65c
commit 9caa0554bc

View File

@ -1108,8 +1108,9 @@
(let loop ()
(unless (check)
(sleep (make-time 'time-duration 10000 0))
(loop))))]
[th (fork-thread
(loop))))])
(mutex-acquire m)
(let ([th (fork-thread
(lambda ()
(let ([bstr (make-bytevector N)])
(box-cas! ready #f 'go)
@ -1122,7 +1123,6 @@
;; Block so that thread becomes deactivated, again
(mutex-acquire m)
(mutex-release m))))])
(mutex-acquire m)
;; Wait for thread to start
(pause-until (lambda () (eq? 'go (unbox ready))))
;; Wait for thread to become inactive, blocked on the mutex
@ -1136,7 +1136,7 @@
(set-box! ready 'finish)
;; Wait for thread to become inactive again
(pause-until (lambda () (= 1 (#%$top-level-value '$active-threads))))
;; Get thread's size, which should'nt include bstr
;; Get thread's size, which shouldn't include bstr
(let ([post-sizes (compute-size-increments (list th))])
(mutex-release m)
;; Wait for thread to exit
@ -1148,9 +1148,9 @@
(compute-size-increments (list th))
;; Main result: detected size of `bstr` in the thread
;; while it was part of the continuation
(or (eq? (current-eval) interpret) ; interpreter continuaton is not precise enough
(or (eq? (current-eval) interpret) ; interpreter continuation is not precise enough
(and (> (car pre-sizes) N)
(< (car post-sizes) N)))))))
(< (car post-sizes) N))))))))
)
(mat collect+compute-size-increments