add a test case to make sure 'Insert Large Letters' doesn't crash
This commit is contained in:
parent
2295f71dbe
commit
a2b03a083a
|
@ -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))))
|
||||
|
|
@ -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)]))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user