From 443434fd01a14dbbb55edb24777f38c56a3007ce Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 16 Sep 2011 12:24:39 -0500
Subject: [PATCH] adjust hangman test suite strategy; instead of waiting for a
 hangman frame to get teh focus, instead wait for a frame in the user's
 eventspace that has the name "Hangman".

also, some minor rackety
---
 collects/tests/drracket/hangman.rkt           | 17 +++++------
 .../drracket/private/drracket-test-util.rkt   | 29 ++++++++++---------
 2 files changed, 23 insertions(+), 23 deletions(-)

diff --git a/collects/tests/drracket/hangman.rkt b/collects/tests/drracket/hangman.rkt
index 844c7a5bf8..ca9c5fca20 100644
--- a/collects/tests/drracket/hangman.rkt
+++ b/collects/tests/drracket/hangman.rkt
@@ -1,9 +1,9 @@
 #lang racket/base
 (require "private/drracket-test-util.rkt"
-         racket/class)
+         racket/class
+         racket/gui/base)
 
 (fire-up-drscheme-and-run-tests 
- #:use-focus-table? #f
  (λ ()
    (define drs (wait-for-drscheme-frame))
    (define defs (send drs get-definitions-text))
@@ -15,10 +15,9 @@
    (do-execute drs)
    (insert-in-interactions drs "(hangman make-word reveal symbol?)")
    (alt-return-in-interactions drs)
-   (define hangman-frame (wait-for-new-frame drs (list (send rep get-user-eventspace))))
-   (cond
-     [(equal? (send hangman-frame get-label) "Hangman")
-      (printf "Hangman test passed.\n")]
-     [else
-      (error 'hangman.rkt "expected a hangman frame to appear, but got one with the label ~s" 
-             (send hangman-frame get-label))])))
+   (define (user-hangman-frame?)
+     (define windows (parameterize ([current-eventspace (send rep get-user-eventspace)])
+                       (get-top-level-windows)))
+     (define labels (map (λ (x) (send x get-label)) windows))
+     (member "Hangman" labels))
+   (poll-until user-hangman-frame?)))
diff --git a/collects/tests/drracket/private/drracket-test-util.rkt b/collects/tests/drracket/private/drracket-test-util.rkt
index a0e377d9da..637e5bffd8 100644
--- a/collects/tests/drracket/private/drracket-test-util.rkt
+++ b/collects/tests/drracket/private/drracket-test-util.rkt
@@ -79,20 +79,21 @@
   ;; poll-until : (-> alpha) number (-> alpha) -> alpha
   ;; waits until pred return a true value and returns that.
   ;; if that doesn't happen by `secs', calls fail and returns that.
-  (define poll-until
-    (lambda (pred [secs 10] [fail (lambda ()
-                                    (error 'poll-until 
-                                           "timeout after ~e secs, ~e never returned a true value"
-                                           secs pred))])
-      (let ([step 1/20])
-        (let loop ([counter secs])
-          (if (<= counter 0)
-              (fail)
-              (let ([result (pred)])
-                (or result
-                    (begin
-                      (sleep step)
-                      (loop (- counter step))))))))))
+  (define (poll-until pred
+                      [secs 10]
+                      [fail (lambda ()
+                              (error 'poll-until 
+                                     "timeout after ~e secs, ~e never returned a true value"
+                                     secs pred))])
+    (let ([step 1/20])
+      (let loop ([counter secs])
+        (if (<= counter 0)
+            (fail)
+            (let ([result (pred)])
+              (or result
+                  (begin
+                    (sleep step)
+                    (loop (- counter step)))))))))
   
   (define (drscheme-frame? frame)
     (method-in-interface? 'get-execute-button (object-interface frame)))