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

Turned blank window into a window with sensible content instead

Browse Source 
svn: r12037
This commit is contained in:
Kathy Gray 2008-10-14 16:44:20 +00:00
parent e802682c4d
commit 20e8888dad
2 changed files with 17 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/test-engine/scheme-tests.ss
View File

@ -263,7 +263,7 @@
(define (build-test-engine) (define (build-test-engine)
(let ([engine (make-object scheme-test%)]) (let ([engine (make-object scheme-test%)])
(send engine setup-info 'check-require) (send engine setup-info 'test-check)
engine)) engine))
(define (insert-test test-info test) (send test-info add-test test)) (define (insert-test test-info test) (send test-info add-test test))

29
collects/test-engine/test-display.scm
View File

@ -39,10 +39,11 @@
(set! drscheme-frame (send current-rep get-top-level-window))) (set! drscheme-frame (send current-rep get-top-level-window)))
(let ([curr-win (and current-tab (send current-tab get-test-window))] (let ([curr-win (and current-tab (send current-tab get-test-window))]
[content (make-object (editor:standard-style-list-mixin text%))]) [content (make-object (editor:standard-style-list-mixin text%))])
(send this insert-test-results content test-info src-editor)
(send content lock #t) (send content lock #t)
(when curr-win (send curr-win update-editor content)) (when curr-win (send curr-win update-editor content))
(when current-tab (send current-tab current-test-editor content)) (when current-tab (send current-tab current-test-editor content))
(when (docked?) (when (and curr-win (docked?))
(send drscheme-frame display-test-panel content) (send drscheme-frame display-test-panel content)
(send curr-win show #f))))) (send curr-win show #f)))))
@ -94,31 +95,33 @@
[(= failed-tests total-tests) "0 tests passed.\n"] [(= failed-tests total-tests) "0 tests passed.\n"]
[else (format "~a of the ~a tests failed.\n\n" failed-tests total-tests)]))))] [else (format "~a of the ~a tests failed.\n\n" failed-tests total-tests)]))))]
[check-outcomes [check-outcomes
(lambda (zero-message) (lambda (zero-message ck)
(send editor insert (send editor insert
(cond (cond
[(zero? total-checks) zero-message] [(zero? total-checks) zero-message]
[(= 1 total-checks) "Ran 1 check.\n"] [(= 1 total-checks) (format "Ran 1 ~a.\n" ck)]
[else (format "Ran ~a checks.\n" total-checks)])) [else (format "Ran ~a ~as.\n" total-checks ck)]))
(when (> total-checks 0) (when (> total-checks 0)
(send editor insert (send editor insert
(cond (cond
[(and (zero? failed-checks) (= 1 total-checks)) [(and (zero? failed-checks) (= 1 total-checks))
"Check passed!\n\n"] (format "The ~a passed!\n\n" ck)]
[(zero? failed-checks) "All checks passed!\n\n"] [(zero? failed-checks) (format "All ~as passed!\n\n" ck)]
[(= failed-checks total-checks) "0 checks passed.\n"] [(= failed-checks total-checks) (format "0 ~as passed.\n" ck)]
[else (format "~a of the ~a checks failed.\n\n" [else (format "~a of the ~a ~as failed.\n\n"
failed-checks total-checks)]))))]) failed-checks ck total-checks)]))))])
(case style (case style
[(test-require) [(test-require)
(test-outcomes "This program must be tested!\n") (test-outcomes "This program must be tested!\n")
(check-outcomes "This program is unchecked!\n")] (check-outcomes "This program is unchecked!\n" "check")]
[(check-require) [(check-require)
(check-outcomes "This program is unchecked!\n")] (check-outcomes "This program is unchecked!\n" "check")]
[(test-basic) [(test-basic)
(test-outcomes "") (test-outcomes "")
(check-outcomes "")] (check-outcomes "" "check")]
[else (check-outcomes "")]) [(test-check)
(check-outcomes "This program must be tested.\n" "test")]
[else (check-outcomes "" "check")])
(unless (and (zero? total-checks) (zero? total-tests)) (unless (and (zero? total-checks) (zero? total-tests))
(inner (display-check-failures (send test-info failed-checks) (inner (display-check-failures (send test-info failed-checks)