summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-06-09 08:55:02 +0200
committerAndy Wingo <wingo@pobox.com>2010-06-09 08:55:02 +0200
commitffd48603b03a104052beb19950941cbfc69f9193 (patch)
treeb69cf5443a2fc9fc3928d1547568759aa9b19ab2
parenta4082ab57e81c1826906c1a8601593e8dea5078c (diff)
downloadguile-ffd48603b03a104052beb19950941cbfc69f9193.tar.gz
r6rs `import' accepts multiple clauses
* module/ice-9/r6rs-libraries.scm (import): Accept multiple clauses. * test-suite/tests/rnrs-libraries.test: Add test.
-rw-r--r--module/ice-9/r6rs-libraries.scm24
-rw-r--r--test-suite/tests/rnrs-libraries.test9
2 files changed, 23 insertions, 10 deletions
diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index 56d430025..482f8264b 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -190,13 +190,19 @@
(define-syntax import
(lambda (stx)
- (syntax-case stx (for)
- ((_ (for import-set import-level ...))
- #'(import import-set))
- ((_ import-set)
- #'(eval-when (eval load compile expand)
- (let ((iface (resolve-r6rs-interface 'import-set)))
- (call-with-deferred-observers
- (lambda ()
- (module-use-interfaces! (current-module) (list iface))))
+ (define (strip-for import-set)
+ (syntax-case import-set (for)
+ ((for import-set import-level ...)
+ #'import-set)
+ (import-set
+ #'import-set)))
+ (syntax-case stx ()
+ ((_ import-set ...)
+ (with-syntax (((library-reference ...) (map strip-for #'(import-set ...))))
+ #'(eval-when (eval load compile expand)
+ (let ((iface (resolve-r6rs-interface 'library-reference)))
+ (call-with-deferred-observers
+ (lambda ()
+ (module-use-interfaces! (current-module) (list iface)))))
+ ...
(if #f #f)))))))
diff --git a/test-suite/tests/rnrs-libraries.test b/test-suite/tests/rnrs-libraries.test
index 4396c6769..e16271400 100644
--- a/test-suite/tests/rnrs-libraries.test
+++ b/test-suite/tests/rnrs-libraries.test
@@ -183,4 +183,11 @@
(with-test-prefix "srfi"
(pass-if "renaming works"
(eq? (resolve-interface '(srfi srfi-1))
- (resolve-r6rs-interface '(srfi :1))))))
+ (resolve-r6rs-interface '(srfi :1)))))
+
+ (with-test-prefix "macro"
+ (pass-if "multiple clauses"
+ (eval '(begin
+ (import (rnrs) (for (rnrs) expand) (rnrs))
+ #t)
+ (current-module)))))