From a412ab8411521772ad98cb3174d4bc49623c280a Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 27 Dec 2012 10:07:09 -0600
Subject: [PATCH] add a basic test of the logger GUI

---
 .../drracket/no-write-and-frame-leak.rkt      | 62 ++++++++++++++++++-
 1 file changed, 60 insertions(+), 2 deletions(-)

diff --git a/collects/tests/drracket/no-write-and-frame-leak.rkt b/collects/tests/drracket/no-write-and-frame-leak.rkt
index 0ab24883f7..dc9eb2026f 100644
--- a/collects/tests/drracket/no-write-and-frame-leak.rkt
+++ b/collects/tests/drracket/no-write-and-frame-leak.rkt
@@ -13,12 +13,17 @@ This test checks:
 
   - if there are any duplicate shortcuts in the menus
 
+  - that the logger GUI is not completely broken (checks
+    that it opens, that it catches a GC message, and that
+    it closes)
+
 |#
 
 (require "private/drracket-test-util.rkt"
          drracket/private/local-member-names
          racket/gui/base
-         framework)
+         framework
+         string-constants)
 
 (define (main)
   (parameterize ([current-security-guard
@@ -34,7 +39,9 @@ This test checks:
     (fire-up-drracket-and-run-tests 
      #:prefs '([plt:framework-pref:drracket:online-compilation-default-on #f]) 
      (λ ()
-       (check-menus (wait-for-drracket-frame))
+       (define drr (wait-for-drracket-frame))
+       (check-log-panel drr)
+       (check-menus drr)
        
        (try-to-find-leak "online compilation disabled:" void)
        
@@ -162,4 +169,55 @@ This test checks:
   (process-container (send frame get-menu-bar))
   (check-shortcuts))
 
+(define (check-log-panel drr)
+  
+  (define (find-log-messages-message)
+    (let loop ([p drr])
+      (cond
+        [(is-a? p area-container<%>)
+         (for/or ([c (in-list (send p get-children))])
+           (loop c))]
+        [(is-a? p message%)
+         (and (equal? (send p get-label) (string-constant log-messages))
+              p)]
+        [else #f])))
+  
+  (test:menu-select "View" "Show Log")
+  
+  ;; wait for the log window to show up.
+  (poll-until
+   (λ ()
+     (queue-callback/res find-log-messages-message)))
+  
+  (collect-garbage)
+  
+  (define logger-string
+    (poll-until
+     (λ ()
+       (define str
+         (queue-callback/res
+          (λ ()
+            (define msg (find-log-messages-message))
+            (define msg-parent-parent (send (send msg get-parent) get-parent))
+            (let loop ([p msg-parent-parent])
+              (cond
+                [(is-a? p area-container<%>)
+                 (for/or ([c (in-list (send p get-children))])
+                   (loop c))]
+                [(is-a? p editor-canvas%)
+                 (send (send p get-editor) get-text)]
+                [else #f])))))
+       (and str
+            (not (equal? str ""))
+            str))))
+  
+  (unless (regexp-match #rx"GC: [0-9]+:MAJ" logger-string)
+    (error 'check-log-panel "didn't find GC log message: ~s" logger-string))
+  
+  (test:menu-select "View" "Hide Log")
+  
+  (poll-until
+   (λ ()
+     (not (queue-callback/res find-log-messages-message)))))
+
 (main)