From a2b03a083a8c5238e05e0eac0501653bf593b443 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 21 Feb 2014 17:29:32 -0600
Subject: [PATCH] add a test case to make sure 'Insert Large Letters' doesn't
 crash

---
 .../drracket/insert-large-letters-test.rkt    | 36 +++++++++++++++++++
 .../drracket/private/insert-large-letters.rkt |  6 +++-
 pkgs/gui-pkgs/gui-lib/framework/test.rkt      | 17 +++++++--
 3 files changed, 56 insertions(+), 3 deletions(-)
 create mode 100644 pkgs/drracket-pkgs/drracket-test/tests/drracket/insert-large-letters-test.rkt

diff --git a/pkgs/drracket-pkgs/drracket-test/tests/drracket/insert-large-letters-test.rkt b/pkgs/drracket-pkgs/drracket-test/tests/drracket/insert-large-letters-test.rkt
new file mode 100644
index 0000000000..d15e614b91
--- /dev/null
+++ b/pkgs/drracket-pkgs/drracket-test/tests/drracket/insert-large-letters-test.rkt
@@ -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))))
+
diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/insert-large-letters.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/insert-large-letters.rkt
index f8f1292cc3..49ae15bee1 100644
--- a/pkgs/drracket-pkgs/drracket/drracket/private/insert-large-letters.rkt
+++ b/pkgs/drracket-pkgs/drracket/drracket/private/insert-large-letters.rkt
@@ -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)]))
diff --git a/pkgs/gui-pkgs/gui-lib/framework/test.rkt b/pkgs/gui-pkgs/gui-lib/framework/test.rkt
index 54ec558114..8e9280027a 100644
--- a/pkgs/gui-pkgs/gui-lib/framework/test.rkt
+++ b/pkgs/gui-pkgs/gui-lib/framework/test.rkt
@@ -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)