~ chicken-core (master) 14bf711c392bd414229d4c28a66cdf069a5cb529


commit 14bf711c392bd414229d4c28a66cdf069a5cb529
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Mar 3 19:34:17 2026 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Mar 3 19:34:17 2026 +0100

    implement missing 2nd part of "gruesome hack" for indirect imports
    (was not migrated from r7rs egg)
    
    reported by Peter McGoron

diff --git a/expand.scm b/expand.scm
index c39c9c04..31223547 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1346,7 +1346,8 @@
                 (else (fail (car decls)))))
        (let ((pd (parse-decls decls)))
          `(##core#module ,real-name ,(if all #t `((,dummy)))
-           ;; gruesome hack: we add a dummy export for adding indirect exports
+           ;; gruesome hack: we add a dummy export for adding indirect exports,
+           ;; see ##sys#register-export, which does the other half.
            ,@(if all
                  '()
                  `((##core#define-syntax ,dummy
diff --git a/modules.scm b/modules.scm
index b9fc3a37..2954ca19 100644
--- a/modules.scm
+++ b/modules.scm
@@ -203,22 +203,36 @@
     (##sys#warn "redefinition of syntax binding" sym)))
 
 (define (##sys#register-export sym mod)
+  (define (find-dummy dummy xl)
+    (cond ((null? xl) #f)
+          ((and (pair? (car xl)) (eq? dummy (caar xl))) (car xl))
+          (else (find-dummy dummy (cdr xl)))))
   (when mod
-    (let ((exp (or (eq? #t (module-export-list mod))
-		   (find-export sym mod #t)))
-	  (ulist (module-undefined-list mod)))
-      (##sys#toplevel-definition-hook	; in compiler, hides unexported bindings
-       sym (module-rename sym (module-name mod)) exp)
-      (and-let* ((a (assq sym ulist)))
-	(set-module-undefined-list! mod (delete a ulist eq?)))
-      (check-for-redef sym (##sys#current-environment) (##sys#macro-environment))
-      (set-module-exist-list! mod (cons sym (module-exist-list mod)))
-      (when exp
-	(dm "defined: " sym)
-	(set-module-defined-list!
-	 mod
-	 (cons (cons sym #f)
-	       (module-defined-list mod)))))) )
+    (let ((el (module-export-list mod))
+          (name (module-name mod)))
+      ;; add any export to the list of indirect exports for the dummy symbol
+      ;; ("gruesome hack", part 2)
+      (and-let* ((dummy (##sys#get name '##r7rs#module)))
+        (unless (eq? sym dummy)
+          (cond ((memq sym el))
+                ((find-dummy dummy el) =>
+                 (lambda (dummylist)
+                   (set-cdr! dummylist (cons sym (cdr dummylist))))))))
+      (let ((exp (or (eq? #t el)  
+                     (find-export sym mod #t)))
+            (ulist (module-undefined-list mod)))
+        (##sys#toplevel-definition-hook ; in compiler, hides unexported bindings
+         sym (module-rename sym name) exp)
+        (and-let* ((a (assq sym ulist)))
+          (set-module-undefined-list! mod (delete a ulist eq?)))
+        (check-for-redef sym (##sys#current-environment) (##sys#macro-environment))
+        (set-module-exist-list! mod (cons sym (module-exist-list mod)))
+        (when exp
+          (dm "defined: " sym)
+          (set-module-defined-list!
+            mod
+            (cons (cons sym #f)
+                  (module-defined-list mod)))))) ))
 
 (define (##sys#register-syntax-export sym mod val)
   (when mod
diff --git a/tests/r7rs-library-tests.scm b/tests/r7rs-library-tests.scm
index c575f085..0c401b9c 100644
--- a/tests/r7rs-library-tests.scm
+++ b/tests/r7rs-library-tests.scm
@@ -1,4 +1,5 @@
 ;; by Anton Idukov (included code was expanded too early)
+
 (define-library (mod)
   (export fx mx)
   (import (scheme base))
@@ -6,3 +7,18 @@
   (include "r7rs-library-tests-code.scm")
 
   )
+
+;; reported by Peter McGoron, hack to handle arbitrary indirect exports was
+;; simply incomplete
+
+(define-library with-indirect-export
+  (import (scheme base))
+  (export bar)
+  (begin
+    (define baz 99) 
+    (define-syntax bar
+      (syntax-rules ()
+        ((_) baz)))))
+
+(import with-indirect-export)
+(assert (= 99 (bar)))
Trap