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

massively faster due to reuse of namespace

Browse Source
This commit is contained in:
John Clements 2010-12-07 20:36:26 -08:00
parent fec54283fb
commit 5456e83ce4
2 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/tests/stepper/test-engine.rkt
View File

@ -178,25 +178,29 @@
(define-namespace-anchor n-anchor)
;; it seems to be okay to use the same namespace for all of the tests...
(define test-namespace (make-base-namespace))
(namespace-attach-module (namespace-anchor->empty-namespace n-anchor)
'mzlib/pconvert-prop
test-namespace)
(parameterize ([current-namespace test-namespace])
(namespace-require 'test-engine/racket-tests)
;; make the test engine happy by adding a binding for test~object:
(namespace-set-variable-value! 'test~object #f))
;; call-iter-on-each : (-> syntax?) (syntax? (-> 'a) -> 'a) -> void/c
;; call the given iter on each syntax in turn (iter bounces control
;; back to us by calling the followup-thunk).
(define (call-iter-on-each stx-thunk iter)
(let ([ns (make-base-namespace)])
;; gets structures to print correctly. Copied from fix in command-line tests.
(namespace-attach-module (namespace-anchor->empty-namespace n-anchor)
'mzlib/pconvert-prop
ns)
(parameterize ([current-namespace ns])
(namespace-require 'test-engine/racket-tests)
;; make the test engine happy by adding a binding for test~object:
(namespace-set-variable-value! 'test~object #f)
(parameterize ([current-namespace test-namespace])
(let iter-loop ()
(let* ([next (stx-thunk)]
[followup-thunk (if (eof-object? next) void iter-loop)]
[followup-thunk (if (eof-object? next)
void
iter-loop)]
[expanded (expand next)])
;;(printf "~v\n" expanded)
(iter expanded followup-thunk))))))
(iter expanded followup-thunk)))))
(define (warn error-box who fmt . args)

6
collects/tests/stepper/through-tests.rkt
View File

@ -1501,10 +1501,10 @@
{(define-struct a_1 (b c))} {1})
(provide ggg)
;; run whatever tests are enabled (intended for interactive use):
(define (ggg)
(parameterize ([disable-stepper-error-handling #t]
(parameterize (#;[disable-stepper-error-handling #t]
#;[display-only-errors #t]
#;[store-steps #f]
#;[show-all-steps #t])
@ -1512,5 +1512,5 @@
check-error check-error-bad))
#;(run-tests '(teachpack-universe))
#;(run-all-tests)
(run-tests '(intermediate-lambda-hof))
(run-tests '(mz-app2))
))