adjust text.rkt test suite to not use racy old way of doing things

gui-test/framework/tests/README

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

gui-test/framework/tests/text.rkt

@@ -1,12 +1,10 @@
-#lang racket/base
+#lang racket
 
-(require racket/file
-         "test-suite-utils.rkt")
-
-(module test racket/base)
-
-(define dummy-frame-title "dummy to avoid quitting")
-(queue-sexp-to-mred `(send (make-object frame:basic% ,dummy-frame-title) show #t))
+(require "private/here-util.rkt"
+         "private/gui.rkt"
+         rackunit
+         racket/gui/base
+         framework)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -15,119 +13,89 @@
 
 
 
-(test
- 'highlight-range1
- (lambda (x) (equal? x 1))
- (λ ()
-   (queue-sexp-to-mred
-    `(let ([t (new text:basic%)])
+(check-equal?
+ (let ([t (new text:basic%)])
    (send t insert "abc")
    (send t highlight-range 1 2 "red")
-       (length (send t get-highlighted-ranges))))))
+   (length (send t get-highlighted-ranges)))
+ 1)
 
-(test
- 'highlight-range2
- (lambda (x) (equal? x 0))
- (λ ()
-   (queue-sexp-to-mred
-    `(let ([t (new text:basic%)])
+(check-equal?
+ (let ([t (new text:basic%)])
    (send t insert "abc")
    ((send t highlight-range 1 2 "red"))
-       (length (send t get-highlighted-ranges))))))
+   (length (send t get-highlighted-ranges)))
+ 0)
 
-
-(test
- 'highlight-range3
- (lambda (x) (equal? x 0))
- (λ ()
-   (queue-sexp-to-mred
-    `(let ([t (new text:basic%)])
+(check-equal?
+ (let ([t (new text:basic%)])
    (send t insert "abc")
    (send t highlight-range 1 2 "red")
    (send t unhighlight-range 1 2 "red")
-       (length (send t get-highlighted-ranges))))))
+   (length (send t get-highlighted-ranges)))
+ 0)
 
 
-(test
- 'highlight-range4
- (lambda (x) (equal? x 1))
- (λ ()
-   (queue-sexp-to-mred
-    `(let ([t (new text:basic%)])
+(check-equal?
+ (let ([t (new text:basic%)])
    (send t insert "abc")
    (send t highlight-range 1 2 "red")
    (send t highlight-range 1 2 "red")
    (send t unhighlight-range 1 2 "red")
-       (length (send t get-highlighted-ranges))))))
+   (length (send t get-highlighted-ranges)))
+ 1)
 
-
-
-(test
- 'highlight-range5
- (lambda (x) (equal? x 0))
- (λ ()
-   (queue-sexp-to-mred
-    `(let ([t (new text:basic%)])
+(check-equal?
+ (let ([t (new text:basic%)])
    (send t insert "abc")
    (send t highlight-range 1 2 "red")
    (send t highlight-range 1 2 "red")
    (send t unhighlight-range 1 2 "red")
    (send t unhighlight-range 1 2 "red")
-       (length (send t get-highlighted-ranges))))))
+   (length (send t get-highlighted-ranges)))
+ 0)
 
 (let ([tmp-file (path->string (make-temporary-file "fwtesttmp~a"))])
-  (test
-   'highlight-range/revert
-   (lambda (x)
-     (delete-file tmp-file)
-     (equal? x 0))
+  (dynamic-wind
+   void
    (λ ()
-     (queue-sexp-to-mred
-      `(let ([t (new text:basic%)])
+     (check-equal?
+      (let ([t (new text:basic%)])
         (send t insert "abc")
-         (send t save-file ,tmp-file)
+        (send t save-file tmp-file)
         (send t highlight-range 0 3 "red")
-         (call-with-output-file ,tmp-file
-           (lambda (port) (display "x\n" port))
+        (call-with-output-file tmp-file
+          (λ (port) (display "x\n" port))
           #:exists 'truncate)
         (send t load-file)
-         (length (send t get-highlighted-ranges)))))))
+        (length (send t get-highlighted-ranges)))
+      0))
+   (λ () (delete-file tmp-file))))
 
-(test
- 'highlight-range-delegate-1
- (lambda (x) (equal? x 0))
- (λ ()
-   (queue-sexp-to-mred
-    `(let ([t (new text:delegate%)])
+(check-equal?
+ (let ([t (new text:delegate%)])
    (send t insert "abc")
    (send t highlight-range 1 2 "red")
    (send t unhighlight-range 1 2 "red")
-       (length (send t get-highlighted-ranges))))))
+   (length (send t get-highlighted-ranges)))
+ 0)
 
-(test
- 'highlight-range-delegate-1
- (lambda (x) (equal? x 0))
- (λ ()
-   (queue-sexp-to-mred
-    `(let ([t (new text:delegate%)])
+(check-equal?
+ (let ([t (new text:delegate%)])
    (send t set-delegate (new text:basic%))
    (send t insert "abc")
    (send t highlight-range 1 2 "red")
    (send t unhighlight-range 1 2 "red")
-       (length (send t get-highlighted-ranges))))))
-
+   (length (send t get-highlighted-ranges)))
+ 0)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  testing get-pos/text method
 ;;
 
-(test
-  'get-pos/text-1
-  (λ (x) x)
-  (λ ()
-    (queue-sexp-to-mred
-      '(let* ([f (new frame% [label "Test frame"])]
+(check-true
+ (let* ([f (new frame% [label "Test frame"])]
         [t (new text:basic%)]
         [c (new editor-canvas% [parent f] [editor t])]
         [snip (make-object string-snip% "Test string")])
@@ -139,14 +107,10 @@
                       [x (add1 (unbox x-box))]
                       [y (add1 (unbox y-box))]))
    (let-values ([(pos edit) (send t get-pos/text event)])
-            (and (real? (car p)) (is-a? (cdr p) text%)))))))
+     (and (real? pos) (is-a? edit text%)))))
 
-(test
-  'get-pos/text-2
-  (λ (x) x)
-  (λ ()
-    (queue-sexp-to-mred
-      '(let* ([f (new frame% [label "Test frame"])]
+(check-true
+ (let* ([f (new frame% [label "Test frame"])]
         [t (new text:basic%)]
         [c (new editor-canvas% [parent f] [editor t])]
         [snip (make-object string-snip% "Test string")])
@@ -158,14 +122,10 @@
                       [x (+ 9999 (unbox x-box))]
                       [y (+ 9999 (unbox y-box))]))
    (let-values ([(pos edit) (send t get-pos/text event)])
-            (and (false? pos) (false? edit)))))))
+     (and (false? pos) (false? edit)))))
 
-(test
-  'get-pos/text-3
-  (λ (x) x)
-  (λ ()
-    (queue-sexp-to-mred
-      '(let* ([f (new frame% [label "Test frame"])]
+(check-true
+ (let* ([f (new frame% [label "Test frame"])]
         [t (new text:basic%)]
         [c (new editor-canvas% [parent f] [editor t])]
         [p (new pasteboard%)]
@@ -180,7 +140,7 @@
                       [x (add1 (unbox x-box))]
                       [y (add1 (unbox y-box))]))
    (let-values ([(pos edit) (send t get-pos/text event)])
-            (and (false? pos) (is-a? edit pasteboard%)))))))
+     (and (false? pos) (is-a? edit pasteboard%)))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -188,169 +148,133 @@
 ;;  all-string-snips<%>
 ;;
 
-(test
- 'all-string-snips<%>.1
- (λ (x) (equal? x #t))
- (λ ()
-   (queue-sexp-to-mred
-    '(let ()
+(check-true
+ (let ()
    (define t (new (text:all-string-snips-mixin text%)))
-       (send t all-string-snips?)))))
+   (send t all-string-snips?)))
 
-(test
- 'all-string-snips<%>.2
- (λ (x) (equal? x #t))
- (λ ()
-   (queue-sexp-to-mred
-    '(let ()
+(check-true
+ (let ()
    (define t (new (text:all-string-snips-mixin text%)))
    (send t insert "xx")
-       (send t all-string-snips?)))))
+   (send t all-string-snips?)))
 
-(test
- 'all-string-snips<%>.3
- (λ (x) (equal? x #t))
- (λ ()
-   (queue-sexp-to-mred
-    '(let ()
+(check-true
+ (let ()
    (define t (new (text:all-string-snips-mixin text%)))
    (send t insert "xx")
    (send t delete 0 1)
-       (send t all-string-snips?)))))
+   (send t all-string-snips?)))
 
-(test
- 'all-string-snips<%>.4
- (λ (x) (equal? x #t))
- (λ ()
-   (queue-sexp-to-mred
-    '(let ()
+(check-true
+ (let ()
    (define t (new (text:all-string-snips-mixin text%)))
    (send t insert "xx")
    (send t delete 0 2)
-       (send t all-string-snips?)))))
+   (send t all-string-snips?)))
 
-(test
- 'all-string-snips<%>.5
- (λ (x) (equal? x #f))
- (λ ()
-   (queue-sexp-to-mred
-    '(let ()
+(check-false
+ (let ()
    (define t (new (text:all-string-snips-mixin text%)))
    (send t insert (new snip%))
-       (send t all-string-snips?)))))
+   (send t all-string-snips?)))
 
-(test
- 'all-string-snips<%>.6
- (λ (x) (equal? x #t))
- (λ ()
-   (queue-sexp-to-mred
-    '(let ()
+(check-true
+ (let ()
    (define t (new (text:all-string-snips-mixin text%)))
    (send t insert (new snip%))
    (send t delete 0 1)
-       (send t all-string-snips?)))))
+   (send t all-string-snips?)))
 
-(test
- 'all-string-snips<%>.7
- (λ (x) (equal? x #f))
- (λ ()
-   (queue-sexp-to-mred
-    '(let ()
+(check-false
+ (let ()
    (define t (new (text:all-string-snips-mixin text%)))
    (send t insert (new snip%))
    (send t insert (new snip%))
    (send t delete 0 1)
-       (send t all-string-snips?)))))
+   (send t all-string-snips?)))
 
-(test
- 'all-string-snips<%>.8
- (λ (x) (equal? x #f))
- (λ ()
-   (queue-sexp-to-mred
-    '(let ()
+(check-false
+ (let ()
    (define t (new (text:all-string-snips-mixin text%)))
    (send t insert (new snip%))
    (send t insert "abcdef")
    (send t insert (new snip%))
    (send t delete 2 4)
-       (send t all-string-snips?)))))
+   (send t all-string-snips?)))
 
-(test
- 'all-string-snips<%>.9
- (λ (x) (equal? x #f))
- (λ ()
-   (queue-sexp-to-mred
-    '(let ()
+(check-false
+ (let ()
    (define t (new (text:all-string-snips-mixin text%)))
    (send t insert "abcdef\n")
    (send t insert (new snip%) (send t last-position))
-       (send t all-string-snips?)))))
+   (send t all-string-snips?)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  searching
 ;;
 
-(define (search-test name setup-code expected-answer)
-  (test
-   name
-   (λ (x) (equal? x expected-answer))
-   (λ ()
-     (send-sexp-to-mred/separate-thread
-      `(let ()
+(define (run-search-test setup-code)
   (define answer (make-channel))
+  (parameterize ([current-eventspace (make-eventspace)])
     (queue-callback
      (λ ()
        (define t (new text:searching%))
-            ,setup-code
+       (setup-code t)
        (let loop ()
          (cond
            [(send t search-updates-pending?)
             (queue-callback (λ () (loop)) #f)]
            [else
             (define-values (before total) (send t get-search-hit-count))
-                 (channel-put answer (list before total))]))))
-         (channel-get answer))))))
+            (channel-put answer (list before total))])))))
+  (channel-get answer))
 
-(search-test
- 'search.1
- `(begin (send t insert "abc")
+(check-equal?
+ (run-search-test
+  (λ (t)
+    (send t insert "abc")
     (send t set-position 0 0)
-         (send t set-searching-state "b" #f #f))
+    (send t set-searching-state "b" #f #f)))
  (list 0 1))
 
-(search-test
- 'search.2
- `(begin (send t insert "abc")
+(check-equal?
+ (run-search-test
+  (λ (t)
+    (send t insert "abc")
     (send t set-position 3 3)
-         (send t set-searching-state "b" #f #f))
+    (send t set-searching-state "b" #f #f)))
  (list 1 1))
 
-(search-test
- 'search.3
- `(begin (send t insert "abc")
+(check-equal?
+ (run-search-test
+  (λ (t)
+    (send t insert "abc")
     (define t2 (new text%))
     (send t2 insert "abc")
     (send t insert (new editor-snip% [editor t2]))
     (send t2 insert "abc")
     (send t set-position 0 0)
-         (send t set-searching-state "b" #f #f))
+    (send t set-searching-state "b" #f #f)))
  (list 0 3))
 
-(search-test
- 'search.4
- `(begin (send t insert "abc")
+(check-equal?
+ (run-search-test
+  (λ (t)
+    (send t insert "abc")
     (define t2 (new text%))
     (send t2 insert "abc")
     (send t insert (new editor-snip% [editor t2]))
     (send t insert "abc")
     (send t set-position (send t last-position) (send t last-position))
-         (send t set-searching-state "b" #f #f))
+    (send t set-searching-state "b" #f #f)))
  (list 3 3))
 
-(search-test
- 'search.5
- `(begin (send t insert "abc")
+(check-equal?
+ (run-search-test
+  (λ (t)
+    (send t insert "abc")
     (define t2 (new text%))
     (send t2 insert "abc")
     (define t3 (new text%))
@@ -360,12 +284,13 @@
     (send t insert (new editor-snip% [editor t2]))
     (send t insert "abc")
     (send t set-position (send t last-position) (send t last-position))
-         (send t set-searching-state "b" #f #f))
+    (send t set-searching-state "b" #f #f)))
  (list 5 5))
 
-(search-test
- 'search.6
- `(begin (send t insert "abc")
+(check-equal?
+ (run-search-test
+  (λ (t)
+    (send t insert "abc")
     (define t2 (new text%))
     (send t2 insert "abc")
     (define t3 (new text%))
@@ -375,44 +300,38 @@
     (send t insert (new editor-snip% [editor t2]))
     (send t insert "abc")
     (send t set-position 0 0)
-         (send t set-searching-state "b" #f #f))
+    (send t set-searching-state "b" #f #f)))
  (list 0 5))
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  print-to-dc
 ;;
 
-(test
- 'print-to-dc
- (λ (x) (equal? x 'no-error))
+(check-not-exn
  (λ ()
-   (queue-sexp-to-mred
-    '(let* ([t (new text:basic%)]
-            [bmp (make-object bitmap% 100 40)]
-            [dc (new bitmap-dc% (bitmap bmp))])
+   (define t (new text:basic%))
+   (define bmp (make-object bitmap% 100 40))
+   (define dc (new bitmap-dc% (bitmap bmp)))
    (send t insert "Hello world")
    (send dc clear)
-       (send t print-to-dc dc 1)
-       'no-error))))
+   (send t print-to-dc dc 1)))
 
 
-(test
- 'print-to-dc2
- (λ (x) (equal? x 'no-error))
+(check-not-exn
  (λ ()
-   (queue-sexp-to-mred
-    `(let* ([f (new frame% [label ""])]
-            [t (new text:basic%)]
-            [ec (new editor-canvas% [parent f] [editor t])]
-            [bmp (make-object bitmap% 100 40)]
-            [dc (new bitmap-dc% (bitmap bmp))])
+   (define f (new frame% [label ""]))
+   (define t (new text:basic%))
+   (define ec (new editor-canvas% [parent f] [editor t]))
+   (define bmp (make-object bitmap% 100 40))
+   (define dc (new bitmap-dc% (bitmap bmp)))
    (send t insert "Hello world")
    (send t highlight-range 2 5 "orange")
    (send f reflow-container)
    (send dc clear)
-       (send t print-to-dc dc 1)
-       'no-error))))
+   (send t print-to-dc dc 1)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -426,75 +345,64 @@
   (define big-str
     (build-string (* buffer-size 2) (λ (i) (integer->char (+ (modulo i 26) (char->integer #\a))))))
   (define non-ascii-str "λαβ一二三四五")
+  
   (define (do/separate-thread str mtd)
-    (queue-sexp-to-mred
-     `(let* ([t (new (text:ports-mixin text:wide-snip%))]
-             [op (send t ,mtd)]
+    (let* ([t (new (text:ports-mixin text:wide-snip%))]
+           [op (case mtd
+                 [(get-out-port) (send t get-out-port)]
+                 [(get-err-port) (send t get-err-port)]
+                 [(get-value-port) (send t get-value-port)])]
            [exn #f])
       (yield
        (thread
         (λ () 
           (with-handlers ((exn:fail? (λ (x) (set! exn x))))
-              (display ,str op)
+            (display str op)
             (flush-output op)))))
       (when exn (raise exn))
-        (send t get-text 0 (send t last-position)))))
+      (send t get-text 0 (send t last-position))))
 
-  (test 
-   'text:ports%.1
-   (λ (x) (equal? x "abc"))
-   (λ () (do/separate-thread "abc" 'get-out-port)))
+  (check-equal?
+   (do/separate-thread "abc" 'get-out-port)
+   "abc")
 
-  (test 
-   'text:ports%.2
-   (λ (x) (equal? x big-str))
-   (λ () (do/separate-thread big-str 'get-out-port)))
+  (check-equal?
+   (do/separate-thread big-str 'get-out-port)
+   big-str)
   
-  (test 
-   'text:ports%.3
-   (λ (x) (equal? x non-ascii-str))
-   (λ () (do/separate-thread non-ascii-str 'get-out-port)))
+  (check-equal?
+   (do/separate-thread non-ascii-str 'get-out-port)
+   non-ascii-str)
   
-  (test 
-   'text:ports%.4
-   (λ (x) (equal? x "abc"))
-   (λ () (do/separate-thread "abc" 'get-err-port)))
+  (check-equal?
+   (do/separate-thread "abc" 'get-err-port)
+   "abc")
   
-  (test 
-   'text:ports%.5
-   (λ (x) (equal? x big-str))
-   (λ () (do/separate-thread big-str 'get-err-port)))
+  (check-equal?
+   (do/separate-thread big-str 'get-err-port)
+   big-str)
   
-  (test 
-   'text:ports%.6
-   (λ (x) (equal? x non-ascii-str))
-   (λ () (do/separate-thread non-ascii-str 'get-err-port)))
+  (check-equal?
+   (do/separate-thread non-ascii-str 'get-err-port)
+   non-ascii-str)
 
+  (check-equal? 
+   (do/separate-thread "abc" 'get-value-port)
+   "abc")
   
-  (test 
-   'text:ports%.7
-   (λ (x) (equal? x "abc"))
-   (λ () (do/separate-thread "abc" 'get-value-port)))
+  (check-equal?
+   (do/separate-thread big-str 'get-value-port) 
+   big-str)
   
-  (test 
-   'text:ports%.8
-   (λ (x) (equal? x big-str))
-   (λ () (do/separate-thread big-str 'get-value-port)))
+  (check-equal?
+   (do/separate-thread non-ascii-str 'get-value-port)
+   non-ascii-str)
   
-  (test 
-   'text:ports%.9
-   (λ (x) (equal? x non-ascii-str))
-   (λ () (do/separate-thread non-ascii-str 'get-value-port)))
   
 ;; display the big string, one char at a time
-  (test
-   'text:ports%.10
-   (λ (x) (equal? x big-str))
-   (λ () 
-     (queue-sexp-to-mred
-      `(let* ([t (new (text:ports-mixin text:wide-snip%))]
+  (check-equal?
+   (let* ([t (new (text:ports-mixin text:wide-snip%))]
           [op (send t get-out-port)]
-              [big-str ,big-str]
           [exn #f])
      (yield
       (thread
@@ -506,108 +414,88 @@
                (loop (+ i 1))))
            (flush-output op)))))
      (when exn (raise exn))
-         (send t get-text 0 (send t last-position))))))
+     (send t get-text 0 (send t last-position)))
+   big-str)
+  
   
   (let ([s "五"])
-    (test
-     'text:ports%.partial-encoding
-     (λ (x) (equal? x s))
-     (λ ()
     (define bts (string->bytes/utf-8 s))
-       (queue-sexp-to-mred
-        `(let ()
+    (check-equal?
+     (let ()
        (define t (new (text:ports-mixin text:wide-snip%)))
        (define p (send t get-out-port))
-           (void (write-bytes (bytes ,(bytes-ref bts 0)) p))
+       (write-bytes (bytes (bytes-ref bts 0)) p)
        (flush-output p)
-           (void (write-bytes ,(subbytes bts 1 (bytes-length bts)) p))
+       (void (write-bytes (subbytes bts 1 (bytes-length bts)) p))
        (flush-output p)
-           (send t get-text))))))
+       (send t get-text))
+     s))
   
   (let ([b (bytes 195 195 (char->integer #\a))])
-    (test
-     'text:ports%.broken-encoding
-     (λ (x) 
-       (define c (bytes-open-converter "UTF-8-permissive" "UTF-8"))
-       (define-values (result-bytes src-read-amt termination) (bytes-convert c b))
-       (equal? x (bytes->string/utf-8 result-bytes)))
-     (λ ()
-       (queue-sexp-to-mred
-        `(let ()
+    (check-equal?
+     (let ()
        (define t (new (text:ports-mixin text:wide-snip%)))
        (define p (send t get-out-port))
        (yield
         (thread
          (λ ()
-               (write-bytes ,b p)
+           (write-bytes b p)
            (flush-output p))))
-           (send t get-text))))))
-
+       (send t get-text))
+     (let ()
+       (define c (bytes-open-converter "UTF-8-permissive" "UTF-8"))
+       (define-values (result-bytes src-read-amt termination) (bytes-convert c b))
+       (bytes->string/utf-8 result-bytes))))
 
   ;; the next tests test the interaction when the current
   ;; thread is the same as the handler thread of the eventspace
   ;; where the text was created
   
-  (test 
-   'text:ports%.thd1
-   (λ (x) (equal? x "abc"))
-   (λ ()
-     (queue-sexp-to-mred
-      `(let* ([t (new (text:ports-mixin text:wide-snip%))]
+  (check-equal?
+   (let* ([t (new (text:ports-mixin text:wide-snip%))]
           [op (send t get-out-port)]
           [exn #f])
      (display "abc" op)
      (flush-output op)
-         (send t get-text 0 (send t last-position))))))
+     (send t get-text 0 (send t last-position)))
+   "abc")
   
-  (test 
-   'text:ports%.thd2
-   (λ (x) (equal? x big-str))
-   (λ ()
-     (queue-sexp-to-mred
-      `(let* ([t (new (text:ports-mixin text:wide-snip%))]
+  (check-equal?
+   (let* ([t (new (text:ports-mixin text:wide-snip%))]
           [op (send t get-out-port)])
-         (display ,big-str op)
+     (display big-str op)
      (flush-output op)
-         (send t get-text 0 (send t last-position))))))
+     (send t get-text 0 (send t last-position)))
+   big-str)
   
-  (test 
-   'text:ports%.thd3
-   (λ (x) (equal? x non-ascii-str))
-   (λ ()
-     (queue-sexp-to-mred
-      `(let* ([t (new (text:ports-mixin text:wide-snip%))]
+  (check-equal?
+   (let* ([t (new (text:ports-mixin text:wide-snip%))]
           [op (send t get-out-port)])
-         (display ,non-ascii-str op)
+     (display non-ascii-str op)
      (flush-output op)
-         (send t get-text 0 (send t last-position))))))
+     (send t get-text 0 (send t last-position)))
+   non-ascii-str)
   
-  (test 
-   'text:ports%.thd4
-   (λ (x) (equal? x non-ascii-str))
-   (λ ()
-     (queue-sexp-to-mred
-      `(let* ([t (new (text:ports-mixin text:wide-snip%))]
+  (check-equal?
+   (let* ([t (new (text:ports-mixin text:wide-snip%))]
           [op (send t get-out-port)])
-         (display ,non-ascii-str op)
+     (display non-ascii-str op)
      (flush-output op)
-         (send t get-text 0 (send t last-position))))))
+     (send t get-text 0 (send t last-position)))
+   non-ascii-str)
 
 
   ;; This test sends a lot of flushes from a separate thread and,
   ;; while doing that, sends a `clear-output-ports` from the
   ;; eventspace main thread where the text was created. The goal
   ;; is to make sure there is no deadlock for this interaction.
-  (test
-   'text:ports%.flush-and-clear-output-ports-interaction
+  (check-pred
    (λ (x)
      ;; we know we're going to get all 'a's, but some of
      ;; the output could be discarded by `clear-output-ports`
-     (and (regexp-match #rx"^a*$" x)
+     (and (regexp-match? #rx"^a*$" x)
           (<= 100 (string-length x) 200)))
-   (λ ()
-     (queue-sexp-to-mred
-      `(let ()
+   (let ()
      (define es (make-eventspace))
      (define-values (text port)
        (let ()
@@ -642,16 +530,13 @@
        (display #\a port)
        (flush-output port))
      (semaphore-wait clear-output-done)
-         (send text get-text))))))
+     (send text get-text))))
 
-(test
- 'text:ports%.undo-does-not-remove-port-colors
+(check-pred
  (λ (x+y)
    (equal? (list-ref x+y 0)
            (list-ref x+y 1)))
- (λ ()
-   (queue-sexp-to-mred
-    `(let ()
+ (let ()
    (define t (new (text:ports-mixin
                    (editor:standard-style-list-mixin
                     text:wide-snip%))))
@@ -684,35 +569,34 @@
        (send t undo)
        (loop)))
    (define after (get-colors))
-       (list before after)))))
+   (list before after)))
 
-(define (test-ascii-art-enlarge-boxes-mixin name before position overwrite? chars after)
-  (test
-   name
-   (λ (got) (equal? got after))
-   (λ ()
-     (queue-sexp-to-mred
-      `(let ([t (new (text:ascii-art-enlarge-boxes-mixin text%))])
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;  ascii art boxes
+;;
+
+(define (ascii-art-enlarge-boxes before position overwrite? chars)
+  (define t (new (text:ascii-art-enlarge-boxes-mixin text%)))
   (send t set-ascii-art-enlarge #t)
   (define f (new frame% [label ""]))
   (define ec (new editor-canvas% [parent f] [editor t]))
-         (send t insert
-               ,before)
-         (send t set-position ,position ,position)
-         ,@(if overwrite? (list '(send t set-overwrite-mode #t)) '())
-         ,@(for/list ([char (in-list chars)])
-             `(send ec on-char (new key-event% [key-code ,char])))
-         (send t get-text))))))
+  (send t insert before)
+  (send t set-position position position)
+  (when overwrite? (send t set-overwrite-mode #t))
+  (for ([char (in-list chars)])
+    (send ec on-char (new key-event% [key-code char])))
+  (send t get-text))
 
 
-(test-ascii-art-enlarge-boxes-mixin 'ascii-art-enlarge.1
+(check-equal? (ascii-art-enlarge-boxes
                (string-append
                 "╔═╦═╗\n"
                 "║ ║ ║\n"
                 "╠═╬═╣\n"
                 "║ ║ ║\n"
                 "╚═╩═╝\n")
-                                    7 #t '(#\a)
+               7 #t '(#\a))
               (string-append
                "╔═╦═╗\n"
                "║a║ ║\n"
@@ -720,14 +604,14 @@
                "║ ║ ║\n"
                "╚═╩═╝\n"))
 
-(test-ascii-art-enlarge-boxes-mixin 'ascii-art-enlarge.2
+(check-equal? (ascii-art-enlarge-boxes
                (string-append
                 "╔═╦═╗\n"
                 "║ ║ ║\n"
                 "╠═╬═╣\n"
                 "║ ║ ║\n"
                 "╚═╩═╝\n")
-                                    7 #t'(#\a #\b)
+               7 #t'(#\a #\b))
               (string-append
                "╔══╦═╗\n"
                "║ab║ ║\n"
@@ -735,14 +619,14 @@
                "║  ║ ║\n"
                "╚══╩═╝\n"))
 
-(test-ascii-art-enlarge-boxes-mixin 'ascii-art-enlarge.3
+(check-equal? (ascii-art-enlarge-boxes
                (string-append
                 "╔═╦═╗\n"
                 "║ ║ ║\n"
                 "╠═╬═╣\n"
                 "║ ║ ║\n"
                 "╚═╩═╝\n")
-                                    7 #f '(#\a)
+               7 #f '(#\a))
               (string-append
                "╔══╦═╗\n"
                "║a ║ ║\n"
@@ -750,7 +634,7 @@
                "║  ║ ║\n"
                "╚══╩═╝\n"))
 
-(test-ascii-art-enlarge-boxes-mixin 'ascii-art-enlarge.4
+(check-equal? (ascii-art-enlarge-boxes
                (string-append
                 "╔═╦═╗\n"
                 "║ ║ ║\n"
@@ -758,7 +642,7 @@
                 "╠═╬═╣\n"
                 "║ ║ ║\n"
                 "╚═╩═╝\n")
-                                    14 #f '(#\f)
+               14 #f '(#\f))
               (string-append
                "╔══╦═╗\n"
                "║  ║ ║\n"