add check for adjacent separators into tests

collects/tests/drracket/no-write-and-frame-leak.rkt

@@ -1,8 +1,24 @@
 #lang racket
+
+#|
+
+This test checks:
+
+  - if opening frames/tabs leaks,
+
+  - if DrRacket writes to the filesystem during startup or
+    while opening tabs/frames
+
+  - if there are any adjacent separators in the menus
+
+|#
+
 (require "private/drracket-test-util.rkt"
+         racket/gui/base
          framework)
 
-(parameterize ([current-security-guard
+(define (main)
+  (parameterize ([current-security-guard
                   (make-security-guard
                    (current-security-guard)
                    (λ (who pth what)
@@ -17,6 +33,8 @@
        (define drs-frame1 (wait-for-drracket-frame))
        (sync (system-idle-evt))
        
+       (check-menus drs-frame1)
+       
        (for ([tries (in-range 3)])
          (test:menu-select "File" "New Tab")
          (sync (system-idle-evt))
@@ -60,4 +78,46 @@
                                  tab-nsb
                                  drs-frame2b
                                  frame2-nsb))
-              (loop (- n 1)))]))))))
+                (loop (- n 1)))])))))))
+
+(define (check-menus frame)
+  
+  (define (process-container container)
+    (define sub-items (send container get-items))
+    (unless (null? sub-items)
+      (when (is-a? (car sub-items) menu-item-container<%>)
+        (process-container (car sub-items)))
+      (define printed? #f)
+      (for ([prev-item (in-list sub-items)]
+            [item (in-list (cdr sub-items))])
+        (when (and (is-a? prev-item separator-menu-item%)
+                   (is-a? item separator-menu-item%)
+                   (not printed?))
+          (set! printed? #t)
+          (eprintf "found two adjacent separator items in: ~s:\n" (get-names container))
+          (for ([item (in-list sub-items)])
+            (eprintf "  ~a\n" (get-lab item)))
+          (eprintf "\n"))
+        (when (is-a? item menu-item-container<%>)
+          (process-container item)))))
+  
+  (define (get-lab item)
+    (cond
+      [(is-a? item labelled-menu-item<%>)
+       (send item get-label)]
+      [(is-a? item separator-menu-item%)
+       "---------"]
+      [else #f]))
+  
+  (define (get-names item)
+    (let loop ([item item])
+      (cond
+        [(is-a? item menu-item<%>)
+         (cons (get-lab item)
+               (loop (send item get-parent)))]
+        [else
+         '()])))
+  
+  (process-container (send frame get-menu-bar)))
+
+(main)