copied 'mzlib/convert-prop attachment from outer layer to inner layer.

(cherry picked from commit 70898379c5)
This commit is contained in:
John Clements 2010-10-19 23:28:45 -07:00 committed by Ryan Culpepper
parent 0ed9334cc1
commit c8b04e77b2
3 changed files with 12 additions and 6 deletions

View File

@ -8,7 +8,7 @@
[current-output-port (open-output-string)]
[current-namespace (make-base-namespace)])
;; make sure the tests' print-convert sees the teaching languages' properties
(namespace-attach-module outer-namespace 'mzlib/pconvert-prop (current-namespace))
#;(namespace-attach-module outer-namespace 'mzlib/pconvert-prop (current-namespace))
(namespace-require 'test-engine/racket-tests)
(if (run-all-tests-except '(bad-and bad-cons check-error begin-let-bug prims qq-splice time set! local-set! lazy1 lazy2 lazy3
local-struct/i local-struct/ilam))

View File

@ -176,12 +176,18 @@
(disable-stepper-error-handling))))
(error-display-handler current-error-display-handler)))
(define-namespace-anchor n-anchor)
;; 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)
(parameterize ([current-namespace (make-base-empty-namespace)])
(namespace-require 'racket/base)
(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)
@ -190,7 +196,7 @@
[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)

View File

@ -1478,5 +1478,5 @@
#;[show-all-steps #t])
#;(run-tests '(check-expect forward-ref check-within check-within-bad check-error check-error-bad))
#;(run-tests '(teachpack-universe))
(run-all-tests)
#;(run-tests '(cond1))))
#;(run-all-tests)
(run-tests '(check-expect))))