adjust the canvas test suite to not do the separate-process dance

gui-test/framework/tests/README

@@ -49,7 +49,7 @@ signal failures when there aren't any.
   | error messages when one fails.
 
   - frames: |# frame.rkt #|
-  - canvases: |# canvas.rkt #|
+  - canvases: canvas.rkt -- now runs directly via raco test.
   - texts: |# text.rkt #|
   - pasteboards: |# pasteboard.rkt #|
 

gui-test/framework/tests/canvas.rkt

@@ -1,29 +1,30 @@
 #lang racket/base
-(require "test-suite-utils.rkt")
+(require "private/here-util.rkt"
+         framework
+         racket/class
+         racket/gui/base
+         rackunit)
 
-(module test racket/base)
+(define (test-creation cls name)
+  (check-true
+   (parameterize ([current-eventspace (make-eventspace)])
+     (define f #f)
+     (queue-callback
+      (λ ()
+        (set! f (make-object frame:basic% "test canvas" #f 300 300))
+        (define c (make-object cls (send f get-area-container)))
+        (send c set-editor (make-object text:wide-snip%))
+        (send f show #t)))
+     (wait-for-frame "test canvas" (current-eventspace))
+     (queue-callback (λ () (send f show #f)))
+     #t)))
 
-(define (test-creation class name)
-  (test
-   name
-   (lambda (x) (eq? 'passed x))
-   (lambda ()
-     (queue-sexp-to-mred
-      `(let* ([f (make-object frame:basic% "test canvas" #f 300 300)]
-	      [c (make-object ,class (send f get-area-container))])
-	 (send c set-editor (make-object text:wide-snip%))
-	 (send f show #t)))
-      (wait-for-frame "test canvas")
-      (queue-sexp-to-mred
-       `(send (get-top-level-focus-window) show #f))
-      'passed)))
+(test-creation (canvas:basic-mixin editor-canvas%)
+               'canvas:basic-mixin-creation)
+(test-creation canvas:basic%
+               'canvas:basic%-creation)
 
-(test-creation '(canvas:basic-mixin editor-canvas%)
-	       'canvas:basic-mixin-creation)
-(test-creation 'canvas:basic%
-	       'canvas:basic%-creation)
-
-(test-creation '(canvas:wide-snip-mixin canvas:basic%)
-	       'canvas:wide-snip-mixin-creation)
-(test-creation 'canvas:wide-snip%
-	       'canvas:wide-snip%-creation)
+(test-creation (canvas:wide-snip-mixin canvas:basic%)
+               'canvas:wide-snip-mixin-creation)
+(test-creation canvas:wide-snip%
+               'canvas:wide-snip%-creation)

gui-test/framework/tests/private/here-util.rkt

@@ -0,0 +1,25 @@
+#lang racket/base
+(require framework/private/focus-table
+         racket/gui/base
+         racket/class)
+
+(provide wait-for-frame)
+
+(define (wait-for/here test)
+  (define timeout 10)
+  (define pause-time 1/2)
+  (let loop ([n (ceiling (/ timeout pause-time))])
+    (if (zero? n)
+        (error 'wait-for "after ~a seconds, ~s didn't come true" timeout test)
+        (unless (test)
+          (sleep pause-time)
+          (loop (- n 1))))))
+
+(define (wait-for-frame name [eventspace (current-eventspace)])
+  (define (check-for-frame)
+    (for/or ([frame (in-list (frame:lookup-focus-table eventspace))])
+      (and (equal? name (send frame get-label))
+           frame)))
+  (wait-for/here
+   (procedure-rename check-for-frame
+                     (string->symbol (format "check-for-frame-named-\"~a\"" name)))))