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

fix bugs in the way the Racket|Disable Tests menu item worked

Browse Source 
also adjust the test-engine-test.rkt test suite to bring it into
sync with the changes to the way the DrRacket REPL works from
commit bfa6b1d953
This commit is contained in:
Robby Findler 2011-11-27 23:49:32 -06:00
parent 2cacbfe8e2
commit 462a348f19
5 changed files with 32 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/deinprogramm/deinprogramm-langs.rkt
View File

@ -170,7 +170,8 @@
[scheme-test-module-name [scheme-test-module-name
((current-module-name-resolver) '(lib "test-engine/scheme-tests.rkt") #f #f)] ((current-module-name-resolver) '(lib "test-engine/scheme-tests.rkt") #f #f)]
[scheme-signature-module-name [scheme-signature-module-name
((current-module-name-resolver) '(lib "deinprogramm/signature/signature-german.rkt") #f #f)]) ((current-module-name-resolver) '(lib "deinprogramm/signature/signature-german.rkt") #f #f)]
[tests-on? (preferences:get 'test-engine:enable?)])
(run-in-user-thread (run-in-user-thread
(lambda () (lambda ()
(when (getenv "PLTDRHTDPNOCOMPILED") (use-compiled-file-paths '())) (when (getenv "PLTDRHTDPNOCOMPILED") (use-compiled-file-paths '()))
@ -201,7 +202,7 @@
(send (send engine get-info) signature-failed (send (send engine get-info) signature-failed
obj signature message blame)))))) obj signature message blame))))))
(scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%)) (scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%))
(test-execute (get-preference 'tests:enable? (lambda () #t))) (test-execute tests-on?)
(signature-checking-enabled? (preferences:get 'signatures:enable-checking?)) (signature-checking-enabled? (preferences:get 'signatures:enable-checking?))
(test-format (make-formatter (lambda (v o) (test-format (make-formatter (lambda (v o)
(render-value/format (if (procedure? v) (render-value/format (if (procedure? v)

5
collects/lang/htdp-langs.rkt
View File

@ -143,7 +143,8 @@
[scheme-test-module-name [scheme-test-module-name
((current-module-name-resolver) '(lib "test-engine/scheme-tests.ss") #f #f)] ((current-module-name-resolver) '(lib "test-engine/scheme-tests.ss") #f #f)]
[scheme-signature-module-name [scheme-signature-module-name
((current-module-name-resolver) '(lib "deinprogramm/signature/signature-english.rkt") #f #f)]) ((current-module-name-resolver) '(lib "deinprogramm/signature/signature-english.rkt") #f #f)]
[tests-on? (preferences:get 'test-engine:enable?)])
(run-in-user-thread (run-in-user-thread
(lambda () (lambda ()
(when (getenv "PLTDRHTDPNOCOMPILED") (use-compiled-file-paths '())) (when (getenv "PLTDRHTDPNOCOMPILED") (use-compiled-file-paths '()))
@ -171,7 +172,7 @@
(send (send engine get-info) signature-failed (send (send engine get-info) signature-failed
obj signature message blame)))))) obj signature message blame))))))
(scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%)) (scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%))
(test-execute (get-preference 'tests:enable? (lambda () #t))) (test-execute tests-on?)
(signature-checking-enabled? (get-preference 'signatures:enable-checking? (lambda () #t))) (signature-checking-enabled? (get-preference 'signatures:enable-checking? (lambda () #t)))
(test-format (make-formatter (lambda (v o) (render-value/format v settings o 40))))))) (test-format (make-formatter (lambda (v o) (render-value/format v settings o 40)))))))
(super on-execute settings run-in-user-thread) (super on-execute settings run-in-user-thread)

2
collects/test-engine/test-tool.scm
View File

@ -181,7 +181,7 @@
(when enabled? (when enabled?
(set! enabled? #f) (set! enabled? #f)
(send this set-label enable-label) (send this set-label enable-label)
(preferences:set 'test-engine:enable? #t))) (preferences:set 'test-engine:enable? #f)))
(super-instantiate ()))] (super-instantiate ()))]
[enable? (preferences:get 'test-engine:enable?)] [enable? (preferences:get 'test-engine:enable?)]
[enable-menu-item (make-object enable-menu-item% [enable-menu-item (make-object enable-menu-item%

24
collects/tests/drracket/test-engine-test.rkt
View File

@ -39,11 +39,11 @@
(list (make-signature-violation "\"bar\"" 1 7))) (list (make-signature-violation "\"bar\"" 1 7)))
(test-expression "(: foo (Integer -> Integer)) (define (foo x) x) (foo \"foo\")" (test-expression "(: foo (Integer -> Integer)) (define (foo x) x) (foo \"foo\")"
"\"foo\"" "\"foo\""
#:repl-expected "foo: this name was defined previously and cannot be re-defined\n\"foo\"" #:repl-expected "foo: this name was defined previously and cannot be re-defined\n"
#:signature-violations-expected #:signature-violations-expected
(list (make-signature-violation "\"foo\" at line 1, column 48 " 1 8)) (list (make-signature-violation "\"foo\" at line 1, column 48 " 1 8))
#:repl-signature-violations-expected #:repl-signature-violations-expected
(list (make-signature-violation "\"foo\" at line 4, column 50 " 1 8))) (list))
(test-expression "(: foo (Integer -> Integer)) (define foo (lambda (x) x))" (test-expression "(: foo (Integer -> Integer)) (define foo (lambda (x) x))"
"" ""
#:repl-expression "(foo \"foo\")" #:repl-expression "(foo \"foo\")"
@ -62,11 +62,11 @@
(list (make-signature-violation "\"bar\"" 1 7))) (list (make-signature-violation "\"bar\"" 1 7)))
(test-expression "(: foo (integer -> integer)) (define foo (lambda (x) x)) (foo \"foo\")" (test-expression "(: foo (integer -> integer)) (define foo (lambda (x) x)) (foo \"foo\")"
"\"foo\"" "\"foo\""
#:repl-expected "define: Zweite Definition für denselben Namen\n\"foo\"" #:repl-expected "define: Zweite Definition für denselben Namen"
#:signature-violations-expected #:signature-violations-expected
(list (make-signature-violation "\"foo\" at line 1, column 57 " 1 8)) (list (make-signature-violation "\"foo\" at line 1, column 57 " 1 8))
#:repl-signature-violations-expected #:repl-signature-violations-expected
(list (make-signature-violation "\"foo\" at line 4, column 59 " 1 8))) (list))
(test-expression "(: foo (integer -> integer)) (define foo (lambda (x) x))" (test-expression "(: foo (integer -> integer)) (define foo (lambda (x) x))"
"" ""
#:repl-expression "(foo \"foo\")" #:repl-expression "(foo \"foo\")"
@ -459,7 +459,20 @@
(check-failures (append signature-violations-expected repl-signature-violations-expected) (check-failures (append signature-violations-expected repl-signature-violations-expected)
(append check-failures-expected repl-check-failures-expected)))) (append check-failures-expected repl-check-failures-expected))))
(define (test-disabling-tests)
(define drs (wait-for-drscheme-frame))
(parameterize ([language (list "How to Design Programs" #rx"Beginning Student(;|$)")])
(prepare-for-test-expression)
(test:menu-select "Racket" "Disable Tests")
(test-expression "(check-expect 1 2)" "Tests disabled.")
(test:menu-select "Racket" "Enable Tests"))
(parameterize ([language (list "DeinProgramm" #rx"Die Macht der Abstraktion - Anfänger(;|$)")])
(prepare-for-test-expression)
(test:menu-select "Racket" "Disable Tests")
(test-expression "(check-expect 1 2)" "Tests disabled.")
(test:menu-select "Racket" "Enable Tests")))
(define-syntax (go stx) (define-syntax (go stx)
(syntax-case stx () (syntax-case stx ()
@ -479,6 +492,7 @@
(go DMdA-beginner) (go DMdA-beginner)
(go DMdA-vanilla) (go DMdA-vanilla)
(go DMdA-assignments) (go DMdA-assignments)
(go DMdA-advanced)) (go DMdA-advanced)
(go test-disabling-tests))
(fire-up-drscheme-and-run-tests run-test) (fire-up-drscheme-and-run-tests run-test)

6
collects/unstable/gui/language-level.rkt
View File

@ -6,6 +6,7 @@
racket/gui/base racket/gui/base
drracket/tool drracket/tool
string-constants string-constants
framework/preferences
(only-in test-engine/scheme-gui make-formatter) (only-in test-engine/scheme-gui make-formatter)
(only-in test-engine/scheme-tests (only-in test-engine/scheme-tests
scheme-test-data test-format test-execute) scheme-test-data test-format test-execute)
@ -151,7 +152,8 @@
(let* ([drracket-namespace (current-namespace)] (let* ([drracket-namespace (current-namespace)]
[test-engine-path [test-engine-path
((current-module-name-resolver) ((current-module-name-resolver)
'test-engine/scheme-tests #f #f)]) 'test-engine/scheme-tests #f #f)]
[tests-on? (preferences:get 'test-engine:enable?)])
(run-in-user-thread (run-in-user-thread
(lambda () (lambda ()
(namespace-attach-module drracket-namespace test-engine-path) (namespace-attach-module drracket-namespace test-engine-path)
@ -160,7 +162,7 @@
(list (drracket:rep:current-rep) (list (drracket:rep:current-rep)
drracket-eventspace drracket-eventspace
test-display%)) test-display%))
(test-execute (get-preference 'tests:enable? (lambda () #t))) (test-execute tests-on?)
(test-format (test-format
(make-formatter (make-formatter
(lambda (v o) (render-value/format v settings o 40)))))) (lambda (v o) (render-value/format v settings o 40))))))