add dynamic-require/expose

original commit: cdc2aaa70c5cb908a16a546386fa2f064cdce6ad
This commit is contained in:
Ryan Culpepper 2014-02-04 11:02:38 -05:00
parent 3e34357795
commit 275b886005
3 changed files with 32 additions and 6 deletions

View File

@ -22,3 +22,13 @@ This example gets @racket[make-failure-test], which is defined in a RackUnit tes
@racketblock[
(require/expose rackunit/private/check-test (make-failure-test))
]
@defproc[(dynamic-require/expose [mod (or/c module-path?
module-path-index?
resolved-module-path?)]
[name symbol?])
any]{
Like @racket[dynamic-require], but gets internal bindings like
@racket[require/expose].
}

View File

@ -60,6 +60,7 @@
around
require/expose
dynamic-require/expose
define-shortcut

View File

@ -35,6 +35,7 @@
"test-case.rkt")
(provide require/expose
dynamic-require/expose
test-suite*
check-regexp-match)
@ -54,11 +55,26 @@
;; Use the correct module-registry
(parameterize ((current-namespace
(variable-reference->namespace (#%variable-reference))))
;; Make sure module the module is instantiated
(dynamic-require the-resolved-mod #f)
;; Get the module namespace
(parameterize ((current-namespace (module->namespace the-resolved-mod)))
(values (eval 'id) ...)))))]))
(dynamic-require/expose* the-resolved-mod '(id ...)))))]))
(define (dynamic-require/expose mod name)
(unless (or (path? mod)
(module-path? mod)
(module-path-index? mod)
(resolved-module-path? mod))
(raise-argument-error 'dynamic-require/expose
"(or/c module-path? module-path-index? resolved-module-path?)"
0 mod name))
(unless (symbol? name)
(raise-argument-error 'dynamic-require/expose "symbol?" 1 mod name))
(dynamic-require/expose* mod (list name)))
(define (dynamic-require/expose* mod names)
;; Make sure module the module is instantiated
(dynamic-require mod #f)
;; Get the module namespace
(parameterize ((current-namespace (module->namespace mod)))
(apply values (map eval names))))
(define-syntax test-suite*
(syntax-rules ()
@ -70,4 +86,3 @@
(define-simple-check (check-regexp-match regex string)
(and (string? string)
(regexp-match regex string)))