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

make the example-test private file's work be behind a thunk (so more drdr friendly)

Browse Source
This commit is contained in:
Robby Findler 2011-01-17 15:02:54 -06:00
parent 36155e913e
commit ff800c997e
2 changed files with 63 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/drracket/example-tool.rkt
View File

@ -29,4 +29,6 @@
(cons (cons
new-collection-root new-collection-root
(current-library-collection-paths))]) (current-library-collection-paths))])
(namespace-require 'tests/drracket/private/run-example-tool)) (namespace-require 'tests/drracket/private/run-example-tool)
(eval '(go)))

109
collects/tests/drracket/private/run-example-tool.rkt
View File

@ -20,61 +20,64 @@
framework/test framework/test
mrlib/switchable-button) mrlib/switchable-button)
(define init-options@ (provide go)
(unit (import setup-option^)
(export)
(make-zo #f)
(make-launchers #f)
(make-docs #f)
(call-install #f)
(call-post-install #f)
(setup-program-name "raco setup")
(specific-collections '(("coll")))))
(let ([c (make-custodian)]) (define (go)
(parameterize ([current-custodian c]
[exit-handler
(λ (x)
(custodian-shutdown-all c))])
(invoke-unit
(compound-unit
(import)
(export)
(link
[((OPTIONS : setup-option^)) setup:option@]
[() init-options@ OPTIONS]
[((LAUNCHER : launcher^)) launcher@]
[((COMPILER-OPTION : compiler:option^)) compiler:option@]
[((DYNEXT-COMPILE : dynext:compile^)) dynext:compile@]
[((DYNEXT-FILE : dynext:file^)) dynext:file@]
[((DYNEXT-LINK : dynext:link^)) dynext:link@]
[((COMPILER : compiler^)) compiler@ COMPILER-OPTION DYNEXT-FILE DYNEXT-COMPILE DYNEXT-LINK]
[() setup@ LAUNCHER OPTIONS COMPILER-OPTION COMPILER DYNEXT-FILE])))))
(fire-up-drscheme-and-run-tests (define init-options@
(λ () (unit (import setup-option^)
(define drs (wait-for-drscheme-frame)) (export)
(queue-callback/res (λ () (send (send drs get-definitions-canvas) focus))) (make-zo #f)
(for ([x (in-string "egg\r1\r2\r3")]) (make-launchers #f)
;; need #\r to actually get newlines in the editor (make-docs #f)
;; see test:keystroke docs (call-install #f)
(test:keystroke x)) (call-post-install #f)
(setup-program-name "raco setup")
(specific-collections '(("coll")))))
(queue-callback/res (let ([c (make-custodian)])
(λ () (parameterize ([current-custodian c]
(define btn [exit-handler
(for/or ([x (in-list (send (send drs get-button-panel) get-children))]) (λ (x)
(and (is-a? x switchable-button%) (custodian-shutdown-all c))])
(equal? (send x get-button-label) "Reverse Definitions") (invoke-unit
x))) (compound-unit
(send btn command))) (import)
(export)
(link
[((OPTIONS : setup-option^)) setup:option@]
[() init-options@ OPTIONS]
[((LAUNCHER : launcher^)) launcher@]
[((COMPILER-OPTION : compiler:option^)) compiler:option@]
[((DYNEXT-COMPILE : dynext:compile^)) dynext:compile@]
[((DYNEXT-FILE : dynext:file^)) dynext:file@]
[((DYNEXT-LINK : dynext:link^)) dynext:link@]
[((COMPILER : compiler^)) compiler@ COMPILER-OPTION DYNEXT-FILE DYNEXT-COMPILE DYNEXT-LINK]
[() setup@ LAUNCHER OPTIONS COMPILER-OPTION COMPILER DYNEXT-FILE])))))
(define content (fire-up-drscheme-and-run-tests
(queue-callback/res (λ () (send (send drs get-definitions-text) get-text)))) (λ ()
(define expected (apply string (reverse (string->list "easter egg\n1\n2\n3")))) (define drs (wait-for-drscheme-frame))
(unless (equal? content expected) (queue-callback/res (λ () (send (send drs get-definitions-canvas) focus)))
(fprintf (current-error-port) (for ([x (in-string "egg\r1\r2\r3")])
"example-tool.rkt: test failed;\nexpected ~s\n but got ~s" ;; need #\r to actually get newlines in the editor
expected ;; see test:keystroke docs
content)))) (test:keystroke x))
(queue-callback/res
(λ ()
(define btn
(for/or ([x (in-list (send (send drs get-button-panel) get-children))])
(and (is-a? x switchable-button%)
(equal? (send x get-button-label) "Reverse Definitions")
x)))
(send btn command)))
(define content
(queue-callback/res (λ () (send (send drs get-definitions-text) get-text))))
(define expected (apply string (reverse (string->list "easter egg\n1\n2\n3"))))
(unless (equal? content expected)
(fprintf (current-error-port)
"example-tool.rkt: test failed;\nexpected ~s\n but got ~s"
expected
content)))))