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

Correction to test enable/disable behavior.

Browse Source 
Hooks for correction to printing out test announcements at inopportune times.

svn: r9754
This commit is contained in:
Kathy Gray 2008-05-08 21:48:02 +00:00
parent 62afb97230
commit c69b4b947e
4 changed files with 45 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
collects/profj/tool.ss
View File

@ -11,6 +11,7 @@
profj/libs/java/lang/Object profj/libs/java/lang/array
profj/libs/java/lang/String)
(require "compile.ss" "parameters.ss" "parsers/lexer.ss" "parser.ss"
(lib "test-engine.scm" "test-engine")
(lib "java-tests.scm" "test-engine")
(lib "test-coverage.scm" "test-engine")
(except-in "ast.ss" for) #;"tester.scm"
@ -791,8 +792,8 @@
(lambda ()
(test-ext? (profj-settings-allow-check? settings))
(testcase-ext? (profj-settings-allow-test? settings))
(tests? (profj-settings-run-tests? settings))
(coverage? (and (tests?) (profj-settings-coverage? settings)))
(test-execute (get-preference 'tests:enable? (lambda () #t)))
(coverage? (and (test-execute) (profj-settings-coverage? settings)))
(error-display-handler
(drscheme:debug:make-debug-error-display-handler (error-display-handler)))
(let ((old-current-eval (drscheme:debug:make-debug-eval-handler (current-eval))))
@ -819,41 +820,40 @@
(cond
((and (not require?) (null? mods) tests-run? (null? extras)) (void))
((and (not require?) (null? mods) (not tests-run?))
(when (tests?)
(let* ([test-engine-obj
(make-object (if (testcase-ext?) java-test-base% java-examples-engine%))]
[tc-info (send test-engine-obj get-info)])
(namespace-set-variable-value! 'current~test~object% tc-info)
(send test-engine-obj install-tests
(map (lambda (c)
(list c (old-current-eval (string->symbol c)) c))
(car examples)))
(when (coverage?)
(send (send test-engine-obj get-info) add-analysis
(make-object coverage-analysis%)))
(send test-engine-obj refine-display-class
(cond
[(and (testcase-ext?) (coverage?)) java-test-coverage-graphics%]
[(coverage?) java-examples-coverage-graphics%]
[(testcase-ext?) java-test-graphics%]
[else java-examples-graphics%]))
(send test-engine-obj run)
(send test-engine-obj setup-display (drscheme:rep:current-rep) e)
(send test-engine-obj summarize-results (current-output-port))
(let ([test-objs (send test-engine-obj test-objects)])
(let inner-loop ((os test-objs))
(unless (null? os)
(let ((formatted
(format-java-value (car os) (make-format-style #t 'field #f))))
(when (< 24 (total-length formatted))
(set! formatted
(format-java-value (car os) (make-format-style #t 'field #t))))
(let loop ((out formatted))
(unless (null? out)
(write-special (car out))
(loop (cdr out))))
(newline))
(inner-loop (cdr os)))))))
(let* ([test-engine-obj
(make-object (if (testcase-ext?) java-test-base% java-examples-engine%))]
[tc-info (send test-engine-obj get-info)])
(namespace-set-variable-value! 'current~test~object% tc-info)
(send test-engine-obj install-tests
(map (lambda (c)
(list c (old-current-eval (string->symbol c)) c))
(car examples)))
(when (coverage?)
(send (send test-engine-obj get-info) add-analysis
(make-object coverage-analysis%)))
(send test-engine-obj refine-display-class
(cond
[(and (testcase-ext?) (coverage?)) java-test-coverage-graphics%]
[(coverage?) java-examples-coverage-graphics%]
[(testcase-ext?) java-test-graphics%]
[else java-examples-graphics%]))
(send test-engine-obj run)
(send test-engine-obj setup-display (drscheme:rep:current-rep) e)
(send test-engine-obj summarize-results (current-output-port))
(let ([test-objs (send test-engine-obj test-objects)])
(let inner-loop ((os test-objs))
(unless (null? os)
(let ((formatted
(format-java-value (car os) (make-format-style #t 'field #f))))
(when (< 24 (total-length formatted))
(set! formatted
(format-java-value (car os) (make-format-style #t 'field #t))))
(let loop ((out formatted))
(unless (null? out)
(write-special (car out))
(loop (cdr out))))
(newline))
(inner-loop (cdr os))))))
(set! tests-run? #t)
(loop mods extras require?))
((and (not require?) (null? mods) tests-run?)

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

@ -274,4 +274,4 @@
(test)
(inner (void) run-test test))))
(provide scheme-test-data test-format test-execute)
(provide scheme-test-data test-format test-execute test-silence)

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

@ -137,9 +137,11 @@
(send this display-results display-rep display-event-space)]))))
(define/public (display-success port)
(fprintf port "All tests passed!~n"))
(unless (test-silence)
(fprintf port "All tests passed!~n")))
(define/public (display-untested port)
(fprintf port "This program should be tested.~n"))
(unless (test-silence)
(fprintf port "This program should be tested.~n")))
(define/public (display-results rep event-space)
(send test-display install-info test-info)
(cond
@ -164,5 +166,6 @@
(define test-format (make-parameter (lambda (v) (format "~a" v))))
(define test-execute (make-parameter #t))
(define test-silence (make-parameter #f))
(provide test-engine% test-display-textual% test-format test-execute)
(provide test-engine% test-display-textual% test-format test-execute test-silence)

2
collects/tests/profj/advanced-tests.ss
View File

@ -443,7 +443,7 @@ class WeeklyPlanner{
(interact-test
'advanced
(list "int[] x = new int[10];"
"for( int i = 0; i< x.length; i++) x[i]=i;" "x.length" "x[5]")
"for( int i = 0; i< x.length; i++) { x[i]=i; }" "x.length" "x[5]")
(list '(void) '(void) 10 5)
"Array & for loop")