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
|
racket/class
|
||||||
string-constants)
|
string-constants)
|
||||||
|
|
||||||
|
(require/typed framework
|
||||||
|
[frame:focus-table-mixin
|
||||||
|
(-> Dialog% Dialog%)])
|
||||||
|
|
||||||
(define-type Bitmap-Message%
|
(define-type Bitmap-Message%
|
||||||
(Class (init [parent (Instance Horizontal-Panel%)])
|
(Class (init [parent (Instance Horizontal-Panel%)])
|
||||||
[set-bm ((Instance Bitmap%) -> Void)]))
|
[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 top-level-window<%> -> void
|
||||||
(: make-large-letters-dialog (String Char Any -> (Option String)))
|
(: make-large-letters-dialog (String Char Any -> (Option String)))
|
||||||
(define (make-large-letters-dialog comment-prefix comment-character parent)
|
(define (make-large-letters-dialog comment-prefix comment-character parent)
|
||||||
(define dlg (new dialog%
|
(define dlg (new (frame:focus-table-mixin dialog%)
|
||||||
[parent parent]
|
[parent parent]
|
||||||
[width 700]
|
[width 700]
|
||||||
[label (string-constant large-semicolon-letters)]))
|
[label (string-constant large-semicolon-letters)]))
|
||||||
|
|
|
@ -226,7 +226,7 @@
|
||||||
(let loop ([window window])
|
(let loop ([window window])
|
||||||
(cond [(not window) #f]
|
(cond [(not window) #f]
|
||||||
[(null? window) #f] ;; is this test needed?
|
[(null? window) #f] ;; is this test needed?
|
||||||
[(eq? window frame) #t]
|
[(object=? window frame) #t]
|
||||||
[else (loop (send window get-parent))]))))
|
[else (loop (send window get-parent))]))))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
|
@ -527,7 +527,20 @@
|
||||||
[(not (send window is-enabled?))
|
[(not (send window is-enabled?))
|
||||||
(error key-tag "focused window is not enabled")]
|
(error key-tag "focused window is not enabled")]
|
||||||
[(not (in-active-frame? window))
|
[(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
|
[else
|
||||||
(let ([event (make-key-event key window modifier-list)])
|
(let ([event (make-key-event key window modifier-list)])
|
||||||
(send-key-event window event)
|
(send-key-event window event)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user