From 8396854c1a7edebfd2af4de820b9073b00346b7c Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 14 Jan 2017 09:15:25 -0600 Subject: [PATCH] port some framework tests to the non-race-condition thing --- gui-test/framework/tests/frame.rkt | 70 ++++++++++++++++++- .../framework/tests/private/here-util.rkt | 2 +- gui-test/framework/tests/text.rkt | 69 ------------------ 3 files changed, 70 insertions(+), 71 deletions(-) diff --git a/gui-test/framework/tests/frame.rkt b/gui-test/framework/tests/frame.rkt index 74458b59..beeb16f0 100644 --- a/gui-test/framework/tests/frame.rkt +++ b/gui-test/framework/tests/frame.rkt @@ -7,7 +7,7 @@ racket/gui/base framework) -(define (test-creation name create) +(define (test-creation name create [verify void]) (check-true (let () (parameterize ([current-eventspace (make-eventspace)]) @@ -20,6 +20,7 @@ (channel-put c (send f get-label)))) (define frame-label (channel-get c)) (wait-for-frame frame-label) + (verify f) (queue-callback (λ () (send f close))) #t)) (format "create ~a" name))) @@ -86,6 +87,72 @@ 'pasteboard%-creation (λ () (new frame:pasteboard%)))) +(define (frame/text-creation-tests) + (define (mk-create f% e%) + (λ () + (define f + (new (class f% + (define/override (get-editor%) e%) + (super-new)))) + (send (send f get-editor) set-max-undo-history 10) + f)) + (define (verify f) + (test:keystroke #\a) + (wait-for/here + (λ () + (define f (test:get-active-top-level-window)) + (and f + (string=? "a" (send (send f get-editor) get-text))))) + (queue-callback + (λ () + (define f (test:get-active-top-level-window)) + ;; remove the `a' to avoid save dialog boxes (and test them, I suppose) + (send (send f get-editor) undo) + (send (send f get-editor) undo) + + (send (send f get-editor) lock #t) + (send (send f get-editor) lock #f)))) + + (test-creation 'text:basic-mixin-creation + (mk-create frame:text% (text:basic-mixin (editor:basic-mixin text%))) + verify) + (test-creation 'text:basic-creation + (mk-create frame:text% text:basic%)) + + (test-creation 'editor:file-mixin-creation + (mk-create frame:text% (editor:file-mixin text:keymap%)) + verify) + + (test-creation 'text:file-creation + (mk-create frame:text% text:file%) + verify) + (test-creation 'text:clever-file-format-mixin-creation + (mk-create frame:text% (text:clever-file-format-mixin text:file%)) + verify) + (test-creation 'text:clever-file-format-creation + (mk-create frame:text% text:clever-file-format%) + verify) + (test-creation 'editor:backup-autosave-mixin-creation + (mk-create frame:text% (editor:backup-autosave-mixin text:clever-file-format%)) + verify) + (test-creation 'text:backup-autosave-creation + (mk-create frame:text% text:backup-autosave%) + verify) + (test-creation 'text:searching-mixin-creation + (mk-create frame:text% (text:searching-mixin text:backup-autosave%)) + verify) + (test-creation 'text:searching-creation + (mk-create frame:text% text:searching%) + verify) + (test-creation 'text:info-mixin-creation + (mk-create (frame:searchable-mixin frame:text%) + (text:info-mixin (editor:info-mixin text:searching%))) + verify) + (test-creation 'text:info-creation + (mk-create (frame:searchable-mixin frame:text%) + text:info%) + verify)) + (define (test-open name cls) (define test-file-contents "test") (check-equal? @@ -263,5 +330,6 @@ (creation-tests) (open-tests) (replace-all-tests) + (frame/text-creation-tests) (send dummy show #f))) diff --git a/gui-test/framework/tests/private/here-util.rkt b/gui-test/framework/tests/private/here-util.rkt index f74636c3..79b493b9 100644 --- a/gui-test/framework/tests/private/here-util.rkt +++ b/gui-test/framework/tests/private/here-util.rkt @@ -3,7 +3,7 @@ racket/gui/base racket/class) -(provide wait-for-frame) +(provide wait-for-frame wait-for/here) (define (wait-for/here test) (define timeout 10) diff --git a/gui-test/framework/tests/text.rkt b/gui-test/framework/tests/text.rkt index f789c455..167f2c25 100644 --- a/gui-test/framework/tests/text.rkt +++ b/gui-test/framework/tests/text.rkt @@ -8,75 +8,6 @@ (define dummy-frame-title "dummy to avoid quitting") (queue-sexp-to-mred `(send (make-object frame:basic% ,dummy-frame-title) show #t)) -(define (test-creation frame% class name) - (test - name - (lambda (x) - (equal? x (list dummy-frame-title))) ;; ensure no frames left - (lambda () - (let ([label - (queue-sexp-to-mred - `(let ([f (new (class ,frame% - (define/override (get-editor%) ,class) - (super-new)))]) - (send (send f get-editor) set-max-undo-history 10) - (send f show #t) - (send f get-label)))]) - (wait-for-frame label) - (send-sexp-to-mred `(test:keystroke #\a)) - (wait-for #:queue? #t `(string=? "a" (send (send (get-top-level-focus-window) get-editor) get-text))) - (queue-sexp-to-mred - `(begin - ;; remove the `a' to avoid save dialog boxes (and test them, I suppose) - (send (send (get-top-level-focus-window) get-editor) undo) - (send (send (get-top-level-focus-window) get-editor) undo) - - (send (send (get-top-level-focus-window) get-editor) lock #t) - (send (send (get-top-level-focus-window) get-editor) lock #f) - (send (get-top-level-focus-window) close))) - (queue-sexp-to-mred `(map (lambda (x) (send x get-label)) (get-top-level-windows))))))) - -#| - (test-creation 'frame:text% - '(text:basic-mixin (editor:basic-mixin text%)) - 'text:basic-mixin-creation) - (test-creation 'frame:text% - 'text:basic% - 'text:basic-creation) - |# -(test-creation 'frame:text% - '(editor:file-mixin text:keymap%) - 'editor:file-mixin-creation) - -(test-creation 'frame:text% - 'text:file% - 'text:file-creation) -(test-creation 'frame:text% - '(text:clever-file-format-mixin text:file%) - 'text:clever-file-format-mixin-creation) -(test-creation 'frame:text% - 'text:clever-file-format% - 'text:clever-file-format-creation) -(test-creation 'frame:text% - '(editor:backup-autosave-mixin text:clever-file-format%) - 'editor:backup-autosave-mixin-creation) -(test-creation 'frame:text% - 'text:backup-autosave% - 'text:backup-autosave-creation) -(test-creation 'frame:text% - '(text:searching-mixin text:backup-autosave%) - 'text:searching-mixin-creation) -(test-creation 'frame:text% - 'text:searching% - 'text:searching-creation) -(test-creation '(frame:searchable-mixin frame:text%) - '(text:info-mixin (editor:info-mixin text:searching%)) - 'text:info-mixin-creation) -(test-creation '(frame:searchable-mixin frame:text%) - 'text:info% - 'text:info-creation) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; testing highlight-range method