~ chicken-core (chicken-5) f8230a466ce3a86f360178f115fb62ee124448b9

commit f8230a466ce3a86f360178f115fb62ee124448b9
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sun Jun 30 18:50:09 2013 +0200
Commit:     Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Mon Jul 8 20:25:41 2013 +0200

    Fix meta-evaluation to actually take place in the meta environment and add tests
    
    Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>

diff --git a/eval.scm b/eval.scm
index 3d571a9b..8d65f2ba 100644
--- a/eval.scm
+++ b/eval.scm
@@ -810,12 +810,15 @@
 (define (##sys#eval/meta form)
   (let ((oldcm (##sys#current-module))
 	(oldme (##sys#macro-environment))
+	(oldce (##sys#current-environment))
 	(mme (##sys#meta-macro-environment))
+	(cme (##sys#current-meta-environment))
 	(aee (##sys#active-eval-environment)))
     (dynamic-wind
 	(lambda () 
 	  (##sys#current-module #f)
 	  (##sys#macro-environment mme)
+	  (##sys#current-environment cme)
 	  (##sys#active-eval-environment ##sys#current-meta-environment))
 	(lambda ()
 	  ((##sys#compile-to-closure
@@ -826,6 +829,8 @@
 	(lambda ()
 	  (##sys#active-eval-environment aee)
 	  (##sys#current-module oldcm)
+	  (##sys#current-meta-environment (##sys#current-environment))
+	  (##sys#current-environment oldce)
 	  (##sys#meta-macro-environment (##sys#macro-environment))
 	  (##sys#macro-environment oldme)))))
 
diff --git a/tests/meta-syntax-test.scm b/tests/meta-syntax-test.scm
index 2b5e4666..2f4b1c91 100755
--- a/tests/meta-syntax-test.scm
+++ b/tests/meta-syntax-test.scm
@@ -20,3 +20,12 @@
      (lambda (e r c)
        (call-it-123 list)))))
 
+(module foo-usage (foo-user)
+  (import chicken scheme)
+  (begin-for-syntax (import (prefix foo foo:)))
+  (define-syntax testing
+    (er-macro-transformer
+     (lambda (x r c)
+       `(,(r 'quote) ,@(foo:bar 1 2)))))
+  (define (foo-user)
+    (testing)))
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 4fdd7fca..83c828db 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -183,10 +183,10 @@ $compile syntax-tests-2.scm
 ./a.out
 
 echo "======================================== meta-syntax tests ..."
-$interpret -bnq meta-syntax-test.scm -e '(import foo)' -e "(assert (equal? '((1)) (bar 1 2)))" -e "(assert (equal? '(list 1 2 3) (listify)))"
+$interpret -bnq meta-syntax-test.scm -e '(import foo)' -e "(assert (equal? '((1)) (bar 1 2)))" -e "(assert (equal? '(list 1 2 3) (listify)))" -e "(import foo-usage)" -e "(assert (equal? '(1) (foo-user)))"
 $compile_s meta-syntax-test.scm -j foo
 $compile_s foo.import.scm
-$interpret -bnq -e '(require-library meta-syntax-test)' -e '(import foo)' -e "(assert (equal? '((1)) (bar 1 2)))" -e "(assert (equal? '(list 1 2 3) (listify)))"
+$interpret -bnq -e '(require-library meta-syntax-test)' -e '(import foo)' -e "(assert (equal? '((1)) (bar 1 2)))" -e "(assert (equal? '(list 1 2 3) (listify)))" -e "(import foo-usage)" -e "(assert (equal? '(1) (foo-user)))"
 
 echo "======================================== reexport tests ..."
 $interpret -bnq reexport-tests.scm