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
This commit is contained in:
Robby Findler 2011-09-16 12:24:39 -05:00
parent c5b3317daf
commit 443434fd01
2 changed files with 23 additions and 23 deletions

View File

@ -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?)))

View File

@ -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)))