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

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

Browse Source 
(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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/stepper/automatic-tests.rkt
View File

@ -8,7 +8,7 @@
[current-output-port (open-output-string)] [current-output-port (open-output-string)]
[current-namespace (make-base-namespace)]) [current-namespace (make-base-namespace)])
;; make sure the tests' print-convert sees the teaching languages' properties ;; 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) (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 (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)) local-struct/i local-struct/ilam))

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

@ -176,12 +176,18 @@
(disable-stepper-error-handling)))) (disable-stepper-error-handling))))
(error-display-handler current-error-display-handler))) (error-display-handler current-error-display-handler)))
(define-namespace-anchor n-anchor)
;; call-iter-on-each : (-> syntax?) (syntax? (-> 'a) -> 'a) -> void/c ;; call-iter-on-each : (-> syntax?) (syntax? (-> 'a) -> 'a) -> void/c
;; call the given iter on each syntax in turn (iter bounces control ;; call the given iter on each syntax in turn (iter bounces control
;; back to us by calling the followup-thunk). ;; back to us by calling the followup-thunk).
(define (call-iter-on-each stx-thunk iter) (define (call-iter-on-each stx-thunk iter)
(parameterize ([current-namespace (make-base-empty-namespace)]) (let ([ns (make-base-namespace)])
(namespace-require 'racket/base) ;; 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) (namespace-require 'test-engine/racket-tests)
;; make the test engine happy by adding a binding for test~object: ;; make the test engine happy by adding a binding for test~object:
(namespace-set-variable-value! 'test~object #f) (namespace-set-variable-value! 'test~object #f)
@ -190,7 +196,7 @@
[followup-thunk (if (eof-object? next) void iter-loop)] [followup-thunk (if (eof-object? next) void iter-loop)]
[expanded (expand next)]) [expanded (expand next)])
;;(printf "~v\n" expanded) ;;(printf "~v\n" expanded)
(iter expanded followup-thunk))))) (iter expanded followup-thunk))))))
(define (warn error-box who fmt . args) (define (warn error-box who fmt . args)

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

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