racket/collects/tests/drscheme/sample-solutions-testsuite-tp.scm
2005-05-27 18:56:37 +00:00

39 lines
1.6 KiB
Scheme

(module sample-solutions-testsuite-tp mzscheme
(provide require-library)
(require (lib "include.ss"))
(define-syntax require-library
(let ([cache null])
(lambda (stx)
(syntax-case stx ()
[(_ fn-stx lib-stx)
(let ([fn (syntax-object->datum (syntax fn-stx))]
[lib (syntax-object->datum (syntax lib-stx))])
(unless (equal? lib "solutions")
(raise-syntax-error
#f
"expected `solutions' collection as second argument to require-library"
stx))
(unless (string? fn)
(raise-syntax-error
#f
"expected string constant as first argument to require-library"
stx))
(if (member fn cache)
(syntax (void))
(with-syntax ([full-fn
(bytes->string/utf-8
(path->bytes
(build-path
(with-handlers ([exn:fail:filesystem?
(lambda (x)
(current-load-relative-directory))])
(collection-path "solutions"))
fn)))]
[orig stx])
(set! cache (cons fn cache))
(syntax
(begin
(include-at/relative-to orig orig full-fn)
(void))))))])))))