From 8c259729092c1115ea5e6427f5d7de6acf6b1b6d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 28 Oct 1998 00:27:31 +0000 Subject: [PATCH] . original commit: 314d99f90aaa541dad8b67b7add0ede20357dcd9 --- collects/tests/mred/mem.ss | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/collects/tests/mred/mem.ss b/collects/tests/mred/mem.ss index 15c070ad..13e72769 100644 --- a/collects/tests/mred/mem.ss +++ b/collects/tests/mred/mem.ss @@ -3,8 +3,8 @@ (define source-dir (current-load-relative-directory)) -(define num-times 8) -(define num-threads 3) +(define num-times 10) +(define num-threads 6) (define dump-stats? #f) @@ -196,16 +196,27 @@ (define (stw t n) (thread-weight t (floor (/ (thread-weight t) n)))) +(define (breakable t) + (if #t + (thread (lambda () + (read) + (printf "breaking~n") + (break-thread t) + (thread-wait t) + (printf "done~n"))) + (void))) + (define (do-test) (let ([sema (make-semaphore)]) (let loop ([n num-threads]) (unless (zero? n) - (thread (lambda () - (stw (current-thread) n) - (dynamic-wind - void - (lambda () (maker n num-times)) - (lambda () (semaphore-post sema))))) + (breakable + (thread (lambda () + (stw (current-thread) n) + (dynamic-wind + void + (lambda () (maker n num-times)) + (lambda () (semaphore-post sema)))))) (loop (sub1 n)))) (let loop ([n num-threads]) (unless (zero? n)