suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Chez Scheme: fix race in a test

Browse Source
This commit is contained in:
Matthew Flatt 2020-10-23 08:28:55 -06:00
parent 614992a65c
commit 9caa0554bc
1 changed files with 40 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
racket/src/ChezScheme/mats/misc.ms
View File

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