~ chicken-core (chicken-5) dd54be4bfdd1fc3b4692111adcf20fbd8998ddca


commit dd54be4bfdd1fc3b4692111adcf20fbd8998ddca
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Mar 24 04:08:01 2011 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Mar 24 04:08:01 2011 -0400

    module-aliases may be local to a module

diff --git a/compiler.scm b/compiler.scm
index 33e317d2..436479a5 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -843,7 +843,10 @@
 					(parameterize ((##sys#current-module 
 							(##sys#register-module name exports) )
 						       (##sys#current-environment '())
-						       (##sys#macro-environment ##sys#initial-macro-environment))
+						       (##sys#macro-environment
+							##sys#initial-macro-environment)
+						       (##sys#module-alias-environment
+							(##sys#module-alias-environment)))
 					    (let loop ((body (cdddr x)) (xs '()))
 					      (cond 
 					       ((null? body)
diff --git a/eval.scm b/eval.scm
index f93fe3c1..f62e6c80 100644
--- a/eval.scm
+++ b/eval.scm
@@ -646,8 +646,11 @@
 			    (parameterize ((##sys#current-module 
 					    (##sys#register-module name exports))
 					   (##sys#current-environment '())
-					   (##sys#macro-environment ##sys#initial-macro-environment))
-				(let loop ((body (cdddr x)) (xs '()))
+					   (##sys#macro-environment 
+					    ##sys#initial-macro-environment)
+					   (##sys#module-alias-environment
+					    (##sys#module-alias-environment)))
+			      (let loop ((body (cdddr x)) (xs '()))
 				  (if (null? body)
 				      (let ((xs (reverse xs)))
 					(##sys#finalize-module (##sys#current-module))
diff --git a/manual/Modules b/manual/Modules
index a63e9531..4c434c2f 100644
--- a/manual/Modules
+++ b/manual/Modules
@@ -79,7 +79,8 @@ like {{(include FILENAME)}}.
 
 The syntax {{(module NAME1 = NAME2)}} defines an alias {{NAME1}}
 for the module {{NAME2}}, so {{NAME1}} can be used in place of 
-{{NAME2}} in all forms that accept module names.
+{{NAME2}} in all forms that accept module names. Module aliases
+defined inside a module are local to that module.
 
 {{(module NAME = (FUNCTORNAME MODULENAME1 ...))}} instantiates
 a ''functor'' (see below for information about functors).
@@ -208,6 +209,8 @@ module-definitions using the {{(interface: INTERFACE)}} syntax.
 See the definition of {{module}} above for an explanation of
 {{EXPORT}} specifications.
 
+Interface names use a distinct global namespace.
+
 
 === import libraries
 
diff --git a/modules.scm b/modules.scm
index cbc802c3..0c13f7d2 100644
--- a/modules.scm
+++ b/modules.scm
@@ -56,7 +56,7 @@
 ;;; low-level module support
 
 (define ##sys#current-module (make-parameter #f))
-(define ##sys#module-alias-environment '())
+(define ##sys#module-alias-environment (make-parameter '()))
 
 (declare 
   (hide make-module module? %make-module
@@ -99,19 +99,19 @@
   (%make-module name explist '() '() '() '() '() '() '() vexports sexports))
 
 (define (##sys#register-module-alias alias name)
-  (set! ##sys#module-alias-environment
-    (cons (cons alias name) ##sys#module-alias-environment)))
+  (##sys#module-alias-environment
+    (cons (cons alias name) (##sys#module-alias-environment))))
 
 (define (##sys#with-module-aliases bindings thunk)
-  (fluid-let ((##sys#module-alias-environment
-	       (append
-		(map (lambda (b) (cons (car b) (cadr b))) bindings)
-		##sys#module-alias-environment)))
+  (parameterize ((##sys#module-alias-environment
+		  (append
+		   (map (lambda (b) (cons (car b) (cadr b))) bindings)
+		   (##sys#module-alias-environment))))
     (thunk)))
 
 (define (##sys#resolve-module-name name loc)
   (let loop ((n name) (done '()))
-    (cond ((assq n ##sys#module-alias-environment) =>
+    (cond ((assq n (##sys#module-alias-environment)) =>
 	   (lambda (a)
 	     (let ((n2 (cdr a)))
 	       (if (memq n2 done)
diff --git a/tests/module-tests.scm b/tests/module-tests.scm
index ac62197f..1bbacfab 100644
--- a/tests/module-tests.scm
+++ b/tests/module-tests.scm
@@ -196,5 +196,34 @@
  "syntax defined in module that is the result of an expansion"
  'abc (abc))
 
+(module m17 (a) (import scheme) (define a 1))
+(module m18 = m17)
+(module m19 (a) (import scheme) (define a 2))
+
+(test-equal
+ "global module alias scope (1)"
+ (module m20 ()
+   (import scheme) 
+   (import m18)
+   a)
+ 1)
+
+(test-equal
+ "local module alias scope"
+ (module m21 ()
+   (import scheme)
+   (module m18 = m19)
+   (import m18)
+   a)
+ 2)
+
+(test-equal
+ "global module alias scope (2)"
+ (module m20 ()
+   (import scheme) 
+   (import m18)
+   a)
+ 1)
+
 (test-end "modules")
 
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 43dfb09f..6959b2b6 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -43,7 +43,7 @@ compile="../csc -compiler $CHICKEN -v -I.. -L.. -include-path .. -o a.out"
 compile_s="../csc -s -compiler $CHICKEN -v -I.. -L.. -include-path .."
 interpret="../csi -n -include-path .."
 
-rm -f *.exe *.so *.o *.import.* a.out
+rm -f *.exe *.so *.o *.import.* a.out ../foo.import.*
 
 echo "======================================== compiler tests ..."
 $compile compiler-tests.scm
Trap