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

removed '(send this ...)' and improved the 'all tests passed' message so it counts the tests

Browse Source 
svn: r12421
This commit is contained in:
Robby Findler 2008-11-13 05:29:42 +00:00
parent 987b164478
commit 3abe7d6bea
1 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/test-engine/test-engine.scm
View File

@ -14,7 +14,7 @@
(inner (void) install-info t)) (inner (void) install-info t))
(define/public (display-results) (define/public (display-results)
(send this insert-test-results test-info)) (insert-test-results test-info))
(define/pubment (insert-test-results test-info) (define/pubment (insert-test-results test-info)
(let* ([style (send test-info test-style)] (let* ([style (send test-info test-style)]
@ -117,7 +117,7 @@
(define/public (add-analysis a) (send test-info add-analysis a)) (define/public (add-analysis a) (send test-info add-analysis a))
(define/public (setup-info style) (define/public (setup-info style)
(set! test-info (make-object (send this info-class) style))) (set! test-info (make-object (info-class) style)))
(define/pubment (setup-display cur-rep event-space) (define/pubment (setup-display cur-rep event-space)
(set! test-display (make-object display-class cur-rep)) (set! test-display (make-object display-class cur-rep))
(set! display-rep cur-rep) (set! display-rep cur-rep)
@ -126,7 +126,7 @@
(define/pubment (run) (define/pubment (run)
(when (test-execute) (when (test-execute)
(unless test-info (send this setup-info 'check-base)) (unless test-info (setup-info 'check-base))
(inner (void) run))) (inner (void) run)))
(define/public (summarize-results port) (define/public (summarize-results port)
(when (test-execute) (when (test-execute)
@ -134,18 +134,26 @@
(let ([result (send test-info summarize-results)]) (let ([result (send test-info summarize-results)])
(send test-display install-info test-info) (send test-display install-info test-info)
(case result (case result
[(no-tests) (send this display-untested port)] [(no-tests) (display-untested port)]
[(all-passed) (send this display-success port display-event-space)] [(all-passed) (display-success port display-event-space
(+ (send test-info tests-run)
(send test-info checks-run)))]
[(mixed-results) [(mixed-results)
(send this display-results display-rep display-event-space)])))) (display-results display-rep display-event-space)]))))
(define/public (display-success port event) (define/private (display-success port event count)
#;(when event #;(when event
(parameterize ([(dynamic-require 'scheme/gui 'current-eventspace) event]) (parameterize ([(dynamic-require 'scheme/gui 'current-eventspace) event])
((dynamic-require 'scheme/gui 'queue-callback) ((dynamic-require 'scheme/gui 'queue-callback)
(lambda () (send test-display report-success))))) (lambda () (send test-display report-success)))))
(unless (test-silence) (unless (test-silence)
(fprintf port "All tests passed!~n"))) (fprintf port "~a test~a passed!\n"
(case count
[(0) "Zero"]
[(1) "The only"]
[(2) "Both"]
[else (format "All ~a" count)])
(if (= count 1) "" "s"))))
(define/public (display-untested port) (define/public (display-untested port)
(unless (test-silence) (unless (test-silence)
(fprintf port "This program should be tested.~n"))) (fprintf port "This program should be tested.~n")))