added an code to avoid a race

svn: r17682
2010-01-17 02:29:29 +00:00 · 2010-01-17 02:29:29 +00:00 · 3046afea04
commit 3046afea04
parent 4189297063
1 changed files with 6 additions and 2 deletions
--- a/collects/2htdp/tests/robby-optimization-gone.ss
+++ b/collects/2htdp/tests/robby-optimization-gone.ss
@ -1,4 +1,4 @@
-#lang scheme
+#lang scheme/gui

 (require 2htdp/universe)
 (require 2htdp/image)
@ -17,4 +17,8 @@
                       (set! s (string-append "-" s))
                       (rectangle 1 1 'solid 'green)))))

-(unless (string=? s "---") (error 'world-update-test "failed! ~s" s))
+(let ([s (make-semaphore)])
+  (queue-callback (λ () (semaphore-post s)))
+  (yield s))
+
+(unless (string=? s "---") (error 'world-update-test "failed! ~s" s))