diff --git a/collects/profj/tool.ss b/collects/profj/tool.ss index 8a0989d980..6befd971e3 100644 --- a/collects/profj/tool.ss +++ b/collects/profj/tool.ss @@ -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?) diff --git a/collects/test-engine/scheme-tests.ss b/collects/test-engine/scheme-tests.ss index 0bf622bffd..df72fec9e9 100644 --- a/collects/test-engine/scheme-tests.ss +++ b/collects/test-engine/scheme-tests.ss @@ -274,4 +274,4 @@ (test) (inner (void) run-test test)))) -(provide scheme-test-data test-format test-execute) \ No newline at end of file +(provide scheme-test-data test-format test-execute test-silence) \ No newline at end of file diff --git a/collects/test-engine/test-engine.scm b/collects/test-engine/test-engine.scm index c547ccf71d..6aeb8042f7 100644 --- a/collects/test-engine/test-engine.scm +++ b/collects/test-engine/test-engine.scm @@ -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) diff --git a/collects/tests/profj/advanced-tests.ss b/collects/tests/profj/advanced-tests.ss index f3aa86c02b..f690eb17f9 100644 --- a/collects/tests/profj/advanced-tests.ss +++ b/collects/tests/profj/advanced-tests.ss @@ -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")