Ticket #901: reexport-syntax-with-star-export-list.diff

expand.scm

@@ -40 +40 @@
 
 (include "common-declarations.scm")
 
-(define-syntax d (syntax-rules () ((_ . _) (void))))
+;(define-syntax d (syntax-rules () ((_ . _) (void))))
 
 (set! ##sys#features
   (append '(#:hygienic-macros 

modules.scm

@@ -170 +170 @@
            exps)
           (set-module-sexports! mod (append sexps (module-sexports mod)))
           (set-module-exist-list! mod (append el exps)))
-        (set-module-export-list!
-         mod (append xl exps)))))
+        (set-module-export-list! mod (append xl exps)))))
 
 (define (##sys#toplevel-definition-hook sym mod exp val) #f)
 
@@ -704 +703 @@
            (when reexp?
              (unless cm
                (##sys#syntax-error-hook loc "`reexport' only valid inside a module"))
-
-             (if (eq? #t (module-export-list cm))
-                 (begin
-                   (set-module-exist-list!
-                    cm
-                    (append (module-exist-list cm)
-                            (map car vsv)
-                            (map car vss))))
-                 (set-module-export-list!
-                  cm
-                  (append
-                   (let ((xl (module-export-list cm) ))
-                     (if (eq? #t xl) '() xl))
-                   (map car vsv)
-                   (map car vss))))
+             (let ((el (module-export-list cm)))
+               (cond ((eq? #t el)
+                      (set-module-sexports! cm (append vss (module-sexports cm)))
+                      (set-module-exist-list!
+                       cm
+                       (append (module-exist-list cm)
+                               (map car vsv)
+                               (map car vss))))
+                     (else
+                      (set-module-export-list!
+                       cm
+                       (append
+                        (let ((xl (module-export-list cm) ))
+                          (if (eq? #t xl) '() xl))
+                        (map car vsv)
+                        (map car vss))))))
              (when (pair? prims)
                (set-module-meta-expressions! 
                 cm

tests/reexport-tests.scm

@@ -36 +36 @@
 (module m3 ()
   (import scheme big-chicken)
   (pp (string-intersperse '("abc" "def" "ghi") "-")))
+
+;;; #901 - reexport with "*" export list
+
+(module
+ m4
+ (foo-m4)
+ (import chicken scheme) 
+ (define-syntax foo-m4
+   (ir-macro-transformer
+    (lambda (e i c)
+      ''1))))
+
+(module
+ m5
+ *                                      ; () works here
+ (import chicken scheme)
+ (reexport m4))
+
+(import m5)
+(print (foo-m4))