make sure threads from thread tests finish

original commit: baf5f3b32940f8060c535428f92b573f46dff9d4
This commit is contained in:
Matthew Flatt 2020-06-06 15:11:17 -06:00
parent e8a52e23a9
commit aa17bc5d5b

View File

@ -1570,5 +1570,17 @@
(equal? gc-ids (list (get-thread-id))))) (equal? gc-ids (list (get-thread-id)))))
) )
(mat wait-for-threads
(begin
;; To avoid breaking later tests that use `(collect)`,
;; wait for any threads created here to exit
(let ()
(define $threads (foreign-procedure "(cs)threads" () scheme-object))
(let loop ()
(unless (= 1 (length ($threads)))
(sleep (make-time 'time-duration 10000 0))
(loop))))
#t)
)
) )