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

rackunit: fix require/expose to work on variable-like macros

Browse Source 
(eg struct names, names w/ contracts, etc)
This commit is contained in:
Ryan Culpepper 2011-07-06 20:59:15 -06:00
parent 9bee07b7c0
commit 3b707c1e54
1 changed files with 18 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
collects/rackunit/private/util.rkt
View File

@ -29,7 +29,7 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base) (require (for-syntax racket/base)
mzlib/etc racket/runtime-path
"check.rkt" "check.rkt"
"test-suite.rkt" "test-suite.rkt"
"test-case.rkt") "test-case.rkt")
@ -38,30 +38,28 @@
test-suite* test-suite*
check-regexp-match) check-regexp-match)
;; Requires a module and exposes some of its unprovided (define-namespace-anchor this-ns)
;; (non-syntax!) identifiers.
;; Requires a module and exposes some of its unprovided identifiers.
;; USAGE: (require/expose MODULE-NAME (IDS ...)) ;; USAGE: (require/expose MODULE-NAME (IDS ...))
;; where MODULE-NAME is as in the MzRacket manual (i.e., ;; where MODULE-NAME is as in the MzRacket manual (i.e.,
;; a standard module spec) and IDS are the un-provided ;; a standard module spec) and IDS are the un-provided
;; identifiers that you wish to expose in the current ;; identifiers that you wish to expose in the current
;; module. ;; module.
(define-syntax (require/expose stx) (define-syntax require/expose
(syntax-case stx () (syntax-rules ()
[(_ mod (ids ...)) [(_ mod (id ...))
(quasisyntax/loc stx
(begin (begin
(require (only-in mod)) (require (only-in mod))
(define-values (ids ...) (define-runtime-module-path the-resolved-mod mod)
(parameterize (define-values (id ...)
([current-load-relative-directory (let ([the-mod (resolved-module-path-name the-resolved-mod)])
#,(datum->syntax ;; Use the correct module-registry:
stx (parameterize ((current-namespace (namespace-anchor->namespace this-ns)))
`(,#'this-expression-source-directory) ;; Get the module namespace:
stx)]) (parameterize ((current-namespace (module->namespace the-mod)))
(let ([ns (module->namespace 'mod)]) ;; Use eval so id-macros (eg struct constructors, names w/ contracts) work:
(parameterize ([current-namespace ns]) (values (eval 'id) ...))))))]))
(values
(namespace-variable-value 'ids)...)))))))]))
(define-syntax test-suite* (define-syntax test-suite*
(syntax-rules () (syntax-rules ()