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:
parent
c5b3317daf
commit
443434fd01
|
@ -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?)))
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue
Block a user