>From b18f1e214def03a6f6ae9842c5a12f781b2813c3 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 30 Jun 2013 18:50:09 +0200
Subject: [PATCH] Fix meta-evaluation to actually take place in the meta
 environment and add tests

---
 eval.scm                   | 5 +++++
 tests/meta-syntax-test.scm | 9 +++++++++
 tests/runtests.sh          | 4 ++--
 3 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/eval.scm b/eval.scm
index 3d571a9..8d65f2b 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 2b5e466..2f4b1c9 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 4fdd7fc..83c828d 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
-- 
1.8.2.3