original commit: f63ce8729fd2bc7c935be039878e782ee20473aa
This commit is contained in:
Matthew Flatt 2003-04-21 21:33:38 +00:00
parent 80e3f7d7d7
commit ca2605fe1c

View File

@ -43,6 +43,35 @@
(yield)
(test v 'dialog-run 11)
(define d (make-object dialog% "Hello"))
(let ([t (thread (lambda ()
(send d show #t)))])
(let loop () (unless (send d is-shown?) (loop)))
(st #t d is-shown?)
(thread-suspend t)
(stv d show #f)
(st #t d is-shown?)
(thread-resume t)
(thread-wait t)
(st #f d is-shown?)
(let ([t (thread (lambda ()
(send d show #t)))])
(let loop () (unless (send d is-shown?) (loop)))
(st #t d is-shown?)
(thread-suspend t)
(stv d show #f)
(let ([t2 (thread (lambda () (send d show #t)))])
(sleep 0.1)
(thread-resume t)
(sleep 0.1)
(st #t d is-shown?)
(test #t 'thread2 (thread-running? t2))
(stv d show #f)
(thread-wait t)
(thread-wait t2)
(st #f d is-shown?))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Parameterization Tests ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;