~ chicken-core (chicken-5) 7bef21de09d279b0413ca94dbef978665c7a0f1c

commit 7bef21de09d279b0413ca94dbef978665c7a0f1c
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Wed Oct 31 22:27:01 2012 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Nov 2 10:32:26 2012 +0100

    Fix #944 by making the behvior of macro-renamed definitions inside modules similar to the behavior at toplevel; they unhygienically introduce identifiers
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 5de86f00..8fd85a30 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -348,7 +348,10 @@
    (##sys#er-transformer
     (lambda (form r c)
       (##sys#check-syntax 'define-values form '(_ #(variable 0) _))
-      (for-each (cut ##sys#register-export <> (##sys#current-module)) (cadr form))
+      (for-each (lambda (nm)
+                  (let ((name (##sys#get nm '##core#macro-alias nm)))
+                    (##sys#register-export name (##sys#current-module))))
+                (cadr form))
       `(,(r 'set!-values) ,@(cdr form))))))
 
 (##sys#extend-macro-environment
diff --git a/expand.scm b/expand.scm
index 660d1fa5..06227e2d 100644
--- a/expand.scm
+++ b/expand.scm
@@ -981,7 +981,8 @@
 	      (body (cddr form)) )
 	  (cond ((not (pair? head))
 		 (##sys#check-syntax 'define form '(_ symbol . #(_ 0 1)))
-		 (##sys#register-export head (##sys#current-module))
+                 (let ((name (or (getp head '##core#macro-alias) head)))
+                   (##sys#register-export name (##sys#current-module)))
 		 (when (c (r 'define) head)
 		   (##sys#defjam-error x))
 		 `(##core#set! 
@@ -1005,7 +1006,8 @@
 	(cond ((not (pair? head))
 	       (##sys#check-syntax 'define-syntax head 'symbol)
 	       (##sys#check-syntax 'define-syntax body '#(_ 1))
-	       (##sys#register-export head (##sys#current-module))
+               (let ((name (or (getp head '##core#macro-alias) head)))
+                 (##sys#register-export name (##sys#current-module)))
 	       (when (c (r 'define-syntax) head)
 		 (##sys#defjam-error form))
 	       `(##core#define-syntax ,head ,(car body)))
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index cc5f246c..6da0277a 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -1054,4 +1054,28 @@ take
     (lambda (e r c) '(quote *)))))
 
 (import rename-builtins)
-(assert (eq? '* (strip-syntax-on-*)))
\ No newline at end of file
+(assert (eq? '* (strip-syntax-on-*)))
+
+;; #944: macro-renamed defines mismatch with the names recorded in module
+;;       definitions, causing the module to be unresolvable.
+
+(module foo ()
+  (import chicken scheme)
+  (define-syntax bar
+    (syntax-rules ()
+      ((_) (begin (define req 1) (display req) (newline)))))
+  (bar))
+
+;; The fix for the above bug causes the req to be defined at toplevel,
+;; unhygienically.  The test below should probably be enabled and this
+;; behavior fixed.  R5RS seems to allow the current behavior though (?),
+;; and some Schemes (at least Gauche) behave the same way.  I think it's
+;; broken, since it's unhygienic.
+#;(module foo ()
+  (import chicken scheme)
+  (define req 1)
+  (define-syntax bar
+    (syntax-rules ()
+      ((_) (begin (define req 2) (display req) (newline)))))
+  (bar)
+  (assert (eq? req 1)))
\ No newline at end of file