From 9846796b6abb6ecbce0d596db32daa7ac5921a2a Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sun, 6 Jun 2010 13:00:59 +0200
Subject: [PATCH] fix module-hygiene corner case by relying more on syntax
 objects

* module/ice-9/psyntax.scm (chi-macro): Instead of assuming that output
  of a macro should be scoped relative to the module that was current
  when the macro was defined, allow the module information associated
  with the syntax object itself to pass through unmolested. Fixes bug
  29860.
  (datum->syntax): Propagate the module of the identifier through to the
  new syntax object, so that datum->syntax preserves module hygiene in
  addition to lexical hygiene.
  (include, include-from-path): Refactor to plumb though the hygiene
  information from the filename instead of the `include', allowing
  hygiene from the original caller of include-from-path to propagate
  through.

* module/ice-9/psyntax-pp.scm: Regenerated.

* test-suite/tests/syncase.test ("macro-generating macro"): Add test for
  bug 29860.
---
 module/ice-9/psyntax-pp.scm   | 28 +++++++++++++++-------------
 module/ice-9/psyntax.scm      | 18 ++++++++++--------
 test-suite/tests/syncase.test | 22 ++++++++++++++++++++++
 3 files changed, 47 insertions(+), 21 deletions(-)

diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index f41402efa..1fbb27972 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -2969,8 +2969,8 @@
                                                   (cons 'shift
                                                         #{s\ 1509}#))
                                             (cons (quote shift) #{s\ 1509}#)))
-                                        (cons 'hygiene
-                                              (cdr #{p\ 1480}#))))))
+                                        (#{syntax-object-module\ 342}#
+                                          #{x\ 1496}#)))))
                                 (if (vector? #{x\ 1496}#)
                                   (let ((#{n\ 1517}#
                                           (vector-length #{x\ 1496}#)))
@@ -12640,7 +12640,7 @@
           (#{make-syntax-object\ 334}#
             #{datum\ 3858}#
             (#{syntax-object-wrap\ 340}# #{id\ 3857}#)
-            #f)))
+            (#{syntax-object-module\ 342}# #{id\ 3857}#))))
       (set! syntax->datum
         (lambda (#{x\ 3861}#)
           (#{strip\ 483}# #{x\ 3861}# (quote (())))))
@@ -15409,7 +15409,7 @@
                                        'each-any)))
                                   (#{read-file\ 4381}#
                                     #{fn\ 4401}#
-                                    #{k\ 4398}#))))
+                                    #{filename\ 4399}#))))
                              #{tmp\ 4395}#)
                       (syntax-violation
                         #f
@@ -15457,15 +15457,17 @@
                                               (hygiene guile))
                                            #{fn\ 4421}#))
                                    #{tmp\ 4419}#))
-                                (let ((#{t\ 4424}#
-                                        (%search-load-path #{fn\ 4417}#)))
-                                  (if #{t\ 4424}#
-                                    #{t\ 4424}#
-                                    (syntax-violation
-                                      'include-from-path
-                                      "file not found in path"
-                                      #{x\ 4408}#
-                                      #{filename\ 4415}#))))))
+                                (datum->syntax
+                                  #{filename\ 4415}#
+                                  (let ((#{t\ 4424}#
+                                          (%search-load-path #{fn\ 4417}#)))
+                                    (if #{t\ 4424}#
+                                      #{t\ 4424}#
+                                      (syntax-violation
+                                        'include-from-path
+                                        "file not found in path"
+                                        #{x\ 4408}#
+                                        #{filename\ 4415}#)))))))
                            #{tmp\ 4411}#)
                     (syntax-violation
                       #f
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 0e0099ef3..c885d22af 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1357,8 +1357,7 @@
                                      (if rib
                                          (cons rib (cons 'shift s))
                                          (cons 'shift s)))
-                          ;; hither the hygiene
-                          (cons 'hygiene (cdr p)))))))
+                          (syntax-object-module x))))))
                 
                 ((vector? x)
                  (let* ((n (vector-length x))
@@ -2413,7 +2412,8 @@
 
   (set! datum->syntax
         (lambda (id datum)
-          (make-syntax-object datum (syntax-object-wrap id) #f)))
+          (make-syntax-object datum (syntax-object-wrap id)
+                              (syntax-object-module id))))
 
   (set! syntax->datum
                                         ; accepts any object, since syntax objects may consist partially
@@ -2754,7 +2754,7 @@
     (syntax-case x ()
       ((k filename)
        (let ((fn (syntax->datum #'filename)))
-         (with-syntax (((exp ...) (read-file fn #'k)))
+         (with-syntax (((exp ...) (read-file fn #'filename)))
            #'(begin exp ...)))))))
 
 (define-syntax include-from-path
@@ -2762,10 +2762,12 @@
     (syntax-case x ()
       ((k filename)
        (let ((fn (syntax->datum #'filename)))
-         (with-syntax ((fn (or (%search-load-path fn)
-                               (syntax-violation 'include-from-path
-                                                 "file not found in path"
-                                                 x #'filename))))
+         (with-syntax ((fn (datum->syntax
+                            #'filename
+                            (or (%search-load-path fn)
+                                (syntax-violation 'include-from-path
+                                                  "file not found in path"
+                                                  x #'filename)))))
            #'(include fn)))))))
 
 (define-syntax unquote
diff --git a/test-suite/tests/syncase.test b/test-suite/tests/syncase.test
index b0e4cbe28..8cc366e4f 100644
--- a/test-suite/tests/syncase.test
+++ b/test-suite/tests/syncase.test
@@ -119,3 +119,25 @@
                 (@@ (new-module)
                     (new-module-macro #t)))
              #:env (current-module))))
+
+(define-module (test-suite test-syncase-2)
+  #:export (make-the-macro))
+
+(define (hello)
+  'hello)
+
+(define-syntax make-the-macro
+  (syntax-rules ()
+    ((_ name)
+     (define-syntax name
+       (syntax-rules ()
+         ((_) (hello)))))))
+
+(define-module (test-suite test-syncase)) ;; back to main module
+(use-modules (test-suite test-syncase-2))
+
+(make-the-macro foo)
+
+(with-test-prefix "macro-generating macro"
+  (pass-if "module hygiene"
+    (eq? (foo) 'hello)))
-- 
2.20.1