~ chicken-core (chicken-5) 4777fb07523457614296e3a1d037f5d8266f464d
commit 4777fb07523457614296e3a1d037f5d8266f464d
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Feb 22 14:55:25 2014 +0100
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Wed Feb 26 21:24:46 2014 +1300
Attempt to fix #219 where renamed reexports are not correctly resolved.
This follows a hint given by sjamaan, in that
"##sys#register-compiled-module" clobbers the syntactic
environments (SEs) of exported syntactic definitions with new complete
SE built from all imports. This patch keeps the old SEs of each
exported syntactic binding my merging instead of overwriting.
This appears to fix the bug and all tests run ok for me, so far.
Signed-off-by: Peter Bex <peter.bex@xs4all.nl>
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/distribution/manifest b/distribution/manifest
index e9e5fcb6..791389e0 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -158,6 +158,8 @@ tests/reexport-m1.scm
tests/reexport-m2.scm
tests/reexport-m3.scm
tests/reexport-m4.scm
+tests/reexport-m5.scm
+tests/reexport-m6.scm
tests/reexport-tests.scm
tests/reexport-tests-2.scm
tests/ec.scm
diff --git a/modules.scm b/modules.scm
index 1fe67d81..913d4489 100644
--- a/modules.scm
+++ b/modules.scm
@@ -375,16 +375,16 @@
(##sys#mark-imported-symbols iexps)
(for-each
(lambda (sexp)
- (set-car! (cdr sexp) senv))
+ (set-car! (cdr sexp) (merge-se (or (cadr sexp) '()) senv)))
sexps)
(for-each
(lambda (iexp)
(when (pair? (cdr iexp))
- (set-car! (cdr iexp) senv)))
+ (set-car! (cdr iexp) (merge-se (or (cadr iexp) '()) senv))))
iexps)
(for-each
(lambda (nexp)
- (set-car! (cdr nexp) senv))
+ (set-car! (cdr nexp) (merge-se (or (cadr nexp) '()) senv)))
nexps)
(set! ##sys#module-table (cons (cons name mod) ##sys#module-table))
mod))
diff --git a/tests/reexport-m3.scm b/tests/reexport-m3.scm
index 202e6b30..4a54802a 100644
--- a/tests/reexport-m3.scm
+++ b/tests/reexport-m3.scm
@@ -1,3 +1,4 @@
+;;; export syntax with implicit value export (reexport-test-2.scm)
(module
reexport-m3
((foo bar))
diff --git a/tests/reexport-m4.scm b/tests/reexport-m4.scm
index c81287bc..4ccea9ec 100644
--- a/tests/reexport-m4.scm
+++ b/tests/reexport-m4.scm
@@ -1,3 +1,4 @@
+;;; export syntax that refers to reexported syntax (reexport-test-2.scm)
(module
reexport-m4
(baz)
diff --git a/tests/reexport-m5.scm b/tests/reexport-m5.scm
new file mode 100644
index 00000000..3e0a92f8
--- /dev/null
+++ b/tests/reexport-m5.scm
@@ -0,0 +1,8 @@
+;;; export syntax, one definition refering to another
+; used for testing reexport wth renaming (reexport-test-2.scm)
+(module reexport-m5 *
+(import scheme)
+(define-syntax s1
+ (syntax-rules () ((_) (s2))))
+(define-syntax s2
+ (syntax-rules () ((_) (display 1)))))
diff --git a/tests/reexport-m6.scm b/tests/reexport-m6.scm
new file mode 100644
index 00000000..803b9b8f
--- /dev/null
+++ b/tests/reexport-m6.scm
@@ -0,0 +1,2 @@
+(module reexport-m6 ()
+(reexport (prefix reexport-m5 f:)))
diff --git a/tests/reexport-tests-2.scm b/tests/reexport-tests-2.scm
index 35ef76db..dadab728 100644
--- a/tests/reexport-tests-2.scm
+++ b/tests/reexport-tests-2.scm
@@ -1,2 +1,8 @@
+;;; export of syntax referring to reexported syntax binding
(use reexport-m4)
(print (baz))
+
+;;; reexport of renamed syntax
+(import reexport-m6)
+(f:s1) ; expands to s2, which is reexported and refers to "s2", which is also visible in this context as "f:s2"
+(f:s2)
diff --git a/tests/runtests.bat b/tests/runtests.bat
index c503f153..120526cb 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -209,6 +209,19 @@ if errorlevel 1 exit /b 1
if errorlevel 1 exit /b 1
a.out
if errorlevel 1 exit /b 1
+%compile_s% reexport-m3.scm -J
+if errorlevel 1 exit /b 1
+%compile_s% reexport-m4.scm -J
+if errorlevel 1 exit /b 1
+%compile_s% reexport-m5.scm -J
+if errorlevel 1 exit /b 1
+%compile_s% reexport-m6.scm -J
+if errorlevel 1 exit /b 1
+%compile% reexport-tests-2.scm
+if errorlevel 1 exit /b 1
+a.out
+if errorlevel 1 exit /b 1
+
echo ======================================== functor tests ...
%interpret% -bnq simple-functors-test.scm
diff --git a/tests/runtests.sh b/tests/runtests.sh
index f902a986..1434eb73 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -210,6 +210,8 @@ $compile reexport-m2.scm
./a.out
$compile_s reexport-m3.scm -J
$compile_s reexport-m4.scm -J
+$compile_s reexport-m5.scm -J
+$compile_s reexport-m6.scm -J
$compile reexport-tests-2.scm
./a.out
Trap