summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2009-08-12 19:22:19 +0200
committerLudovic Courtès <ludo@gnu.org>2009-08-13 15:57:01 +0200
commit16f451f308cd79168d2b1d1314b324dff96fde0d (patch)
treef5c1288206ee215ed7d79e95b6842d70a1fc8b5c
parentb9434165b67fa66aae58511c78508580bf7bd353 (diff)
downloadguile-16f451f308cd79168d2b1d1314b324dff96fde0d.tar.gz
Allow fresh modules to be passed to `compile'.
* module/ice-9/boot-9.scm (module-name): When making MOD non-anonymous, bind it in the `(%app modules)' name space. * test-suite/tests/compiler.test ("psyntax")["compile in current module", "compile in fresh module"]: New tests. * test-suite/tests/modules.test ("foundations")["modules don't remain anonymous"]: New test.
-rw-r--r--module/ice-9/boot-9.scm9
-rw-r--r--test-suite/tests/compiler.test22
-rw-r--r--test-suite/tests/modules.test9
3 files changed, 34 insertions, 6 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 36a463ad3..01569cbf9 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1982,8 +1982,13 @@
(let ((accessor (record-accessor module-type 'name)))
(lambda (mod)
(or (accessor mod)
- (begin
- (set-module-name! mod (list (gensym)))
+ (let ((name (list (gensym))))
+ ;; Name MOD and bind it in THE-ROOT-MODULE so that it's visible
+ ;; to `resolve-module'. This is important as `psyntax' stores
+ ;; module names and relies on being able to `resolve-module'
+ ;; them.
+ (set-module-name! mod name)
+ (nested-define! the-root-module `(%app modules ,@name) mod)
(accessor mod))))))
;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index fe9d7765f..9c84fd7b4 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
;;;; compiler.test --- tests for the compiler -*- scheme -*-
-;;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999, 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -19,8 +19,9 @@
:use-module (test-suite lib)
:use-module (test-suite guile-test)
:use-module (system base compile))
-
+
+
(with-test-prefix "basic"
(pass-if "compile to value"
@@ -34,4 +35,19 @@
;; imported `round'. See the same test in `syntax.test' for details.
(let ((o1 (compile '(define round round)))
(o2 (compile '(eq? round (@@ (guile) round)))))
- o2)))
+ o2))
+
+ (pass-if "compile in current module"
+ (let ((o1 (compile '(define-macro (foo) 'bar)))
+ (o2 (compile '(let ((bar 'ok)) (foo)))))
+ (and (module-ref (current-module) 'foo)
+ (eq? o2 'ok))))
+
+ (pass-if "compile in fresh module"
+ (let* ((m (let ((m (make-module)))
+ (beautify-user-module! m)
+ m))
+ (o1 (compile '(define-macro (foo) 'bar) #:env m))
+ (o2 (compile '(let ((bar 'ok)) (foo)) #:env m)))
+ (and (module-ref m 'foo)
+ (eq? o2 'ok)))))
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
index 696c35ca2..f22cfe9c1 100644
--- a/test-suite/tests/modules.test
+++ b/test-suite/tests/modules.test
@@ -1,6 +1,6 @@
;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*-
-;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -34,6 +34,13 @@
(with-test-prefix "foundations"
+ (pass-if "modules don't remain anonymous"
+ ;; This is a requirement for `psyntax': it stores module names and relies
+ ;; on being able to `resolve-module' them.
+ (let ((m (make-module)))
+ (and (module-name m)
+ (eq? m (resolve-module (module-name m))))))
+
(pass-if "module-add!"
(let ((m (make-module))
(value (cons 'x 'y)))