~ 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