suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

port some framework tests to the non-race-condition thing

Browse Source
This commit is contained in:
Robby Findler 2017-01-14 09:15:25 -06:00
parent cc57412ac7
commit 8396854c1a
3 changed files with 70 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
gui-test/framework/tests/frame.rkt
View File

@ -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)))

2
gui-test/framework/tests/private/here-util.rkt
View File

@ -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)

69
gui-test/framework/tests/text.rkt
View File

@ -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