add a test case to make sure 'Insert Large Letters' doesn't crash

This commit is contained in:
Robby Findler 2014-02-21 17:29:32 -06:00
parent 2295f71dbe
commit a2b03a083a
3 changed files with 56 additions and 3 deletions

View File

@ -0,0 +1,36 @@
#lang racket
(require tests/drracket/private/drracket-test-util
drracket/private/local-member-names
racket/gui/base
framework
rackunit
string-constants)
(fire-up-drracket-and-run-tests
(λ ()
(define drr (wait-for-drracket-frame))
(queue-callback/res (λ () (send (send drr get-definitions-canvas) focus)))
(test:menu-select "Insert" "Insert Large Letters...")
(define insert-frame (wait-for-new-frame drr))
(for ([c (in-string "TR Rulez!")])
(test:keystroke c))
(test:button-push "OK")
(wait-for-new-frame insert-frame)
(define defs-content
(queue-callback/res
(λ () (send (send drr get-definitions-text) get-text))))
(define semis (for/sum ([i (in-string defs-content)])
(if (equal? i #\;)
1
0)))
(define spaces (for/sum ([i (in-string defs-content)])
(if (equal? i #\space)
1
0)))
(unless (and (< 20 spaces)
(< 20 semis))
(error 'insert-large-letters-test.rkt
"expected more semis or spaces; definitions content was:\n~a"
defs-content))))

View File

@ -5,6 +5,10 @@
racket/class
string-constants)
(require/typed framework
[frame:focus-table-mixin
(-> Dialog% Dialog%)])
(define-type Bitmap-Message%
(Class (init [parent (Instance Horizontal-Panel%)])
[set-bm ((Instance Bitmap%) -> Void)]))
@ -46,7 +50,7 @@
;; make-large-letters-dialog : string char top-level-window<%> -> void
(: make-large-letters-dialog (String Char Any -> (Option String)))
(define (make-large-letters-dialog comment-prefix comment-character parent)
(define dlg (new dialog%
(define dlg (new (frame:focus-table-mixin dialog%)
[parent parent]
[width 700]
[label (string-constant large-semicolon-letters)]))

View File

@ -226,7 +226,7 @@
(let loop ([window window])
(cond [(not window) #f]
[(null? window) #f] ;; is this test needed?
[(eq? window frame) #t]
[(object=? window frame) #t]
[else (loop (send window get-parent))]))))
;;
@ -527,7 +527,20 @@
[(not (send window is-enabled?))
(error key-tag "focused window is not enabled")]
[(not (in-active-frame? window))
(error key-tag "focused window is not in active frame")]
(error
key-tag
(string-append
"focused window is not in active frame;"
"active frame's label is ~s and focused window is in a frame with label ~s")
(let ([f (test:get-active-top-level-window)])
(and f (send (test:get-active-top-level-window) get-label)))
(let loop ([p window])
(cond
[(is-a? p top-level-window<%>)
(send p get-label)]
[(is-a? p area<%>)
(loop (send p get-parent))]
[else #f])))]
[else
(let ([event (make-key-event key window modifier-list)])
(send-key-event window event)