~ chicken-core (chicken-5) be4ec378a6f47a94805652b6f126e95967cbb805

commit be4ec378a6f47a94805652b6f126e95967cbb805
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Mar 12 11:14:35 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Mar 12 11:14:35 2010 +0100

    module bodies are completely stripped (#131)

diff --git a/compiler.scm b/compiler.scm
index 6ca15a62..47fa3b7d 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -812,7 +812,8 @@
 			 e se dest))
 
 		       ((##core#module)
-			(let* ((name (##sys#strip-syntax (cadr x)))
+			(let* ((x (##sys#strip-syntax x))
+			       (name (##sys#strip-syntax (cadr x)))
 			       (exports 
 				(or (eq? #t (caddr x))
 				    (map (lambda (exp)
diff --git a/eval.scm b/eval.scm
index 6bf69fda..c51f12c4 100644
--- a/eval.scm
+++ b/eval.scm
@@ -645,7 +645,8 @@
 			   e #f tf cntr se))
 
 			 ((##core#module)
-			  (let* ((name (##sys#strip-syntax (cadr x)))
+			  (let* ((x (##sys#strip-syntax x))
+				 (name (##sys#strip-syntax (cadr x)))
 				 (exports 
 				  (or (eq? #t (caddr x))
 				      (map (lambda (exp)
diff --git a/expand.scm b/expand.scm
index bd37221c..1df2b394 100644
--- a/expand.scm
+++ b/expand.scm
@@ -57,7 +57,7 @@
     (no-procedure-checks)))
  (else))
 
-(begin
+#;(begin
   (define-syntax dd (syntax-rules () ((_ . _) (void))))
   (define-syntax dm (syntax-rules () ((_ . _) (void))))
   (define-syntax dc (syntax-rules () ((_ . _) (void)))) )
diff --git a/tests/module-tests.scm b/tests/module-tests.scm
index 71846074..ac62197f 100644
--- a/tests/module-tests.scm
+++ b/tests/module-tests.scm
@@ -163,4 +163,38 @@
   (use (prefix (rename srfi-1 (filter f)) 99:))
   (print 99:f))
 
+
+;;; expansion of macros into modules:
+
+(module m16 (foo-module)
+
+(import scheme chicken)
+
+(define-syntax foo-module
+  (syntax-rules ()
+    ((_ name)
+     (module name (maker definer)
+       (import scheme chicken)
+       (define (maker) 'name)
+       (define-syntax definer
+         (syntax-rules () 
+           ((_) (define (name) 'name))))))))
+
+)
+
+(import m16)
+(foo-module abc)
+(import abc)
+
+(test-equal 
+ "function defined in module that is the result of an expansion"
+ 'abc (maker))
+
+(definer)
+
+(test-equal 
+ "syntax defined in module that is the result of an expansion"
+ 'abc (abc))
+
 (test-end "modules")
+
diff --git a/tests/runtests.sh b/tests/runtests.sh
index f14acc3d..e95fe19a 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -164,7 +164,7 @@ $interpret -s srfi-4-tests.scm
 
 echo "======================================== srfi-18 tests ..."
 $interpret -s srfi-18-tests.scm
-echo "*** Skipping \"feeley-dynwind\" (for now) ***"
+echo "*** Skipping \"feeley-dynwind\" for now ***"
 # $interpret -s feeley-dynwind.scm
 
 echo "======================================== path tests ..."