From 7864436594fb08ef5cb843a835c9f34d9e55ff76 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 28 Jul 2015 10:03:49 -0600
Subject: [PATCH] fix top-level scope introduction

Although `eval-syntax` is not supposed to add the current namespace's
"outer edge" scope, it must add the "inner edge" scope to be consistent
with adding the inner edge to every intermediate expansion (as in
other definition contexts).

In addition, `eval`, `eval-syntax`, `expand`, and `expand-syntax`
did not cooperate properly with `local-expand` on the inner edge.
---
 .../racket-test-core/tests/racket/syntax.rktl | 32 ++++++++++++++++---
 racket/src/racket/src/eval.c                  | 15 ++++++---
 2 files changed, 37 insertions(+), 10 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/syntax.rktl b/pkgs/racket-test-core/tests/racket/syntax.rktl
index a2988e2f2c..421bcdf00c 100644
--- a/pkgs/racket-test-core/tests/racket/syntax.rktl
+++ b/pkgs/racket-test-core/tests/racket/syntax.rktl
@@ -1885,17 +1885,39 @@
                               (x #:flag? #t)))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Check that the default eval handler doesn't add to much context:
+;; Check that the default eval handler doesn't add too much context:
 
 (parameterize ([current-namespace (make-base-namespace)])
   (eval '(define thing 5))
   (test #f
-        hash-ref
+        (lambda (info)
+          (ormap
+           (lambda (b)
+             (subset? (hash-ref b 'context null)
+                      (hash-ref info 'context)))
+           (hash-ref info 'bindings null)))
         (syntax-debug-info
          ((current-eval) (datum->syntax (namespace-syntax-introduce #'top)
-                                        (cons 'quote-syntax (datum->syntax #f '(thing))))))
-        'bindings
-        #f))
+                                        (cons 'quote-syntax (datum->syntax #f '(thing))))))))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check that `eval-syntax` cooperates with `local-expand` on 
+;; a top-level inner-edge scope
+
+(parameterize ([current-namespace (make-base-namespace)])
+  (namespace-require '(for-syntax racket/base))
+  (eval-syntax (datum->syntax #f `(,#'define x ,#'1)))
+  (eval '(define-syntax-rule (same x) x))
+  (eval '(define-syntax (m stx)
+          (syntax-case stx ()
+            [(_ same-e) (let ([id (local-expand #'same-e 'top-level null)])
+                          (unless (identifier-binding id)
+                            (error "not bound")))])))
+  (eval-syntax (datum->syntax #f
+                              (list
+                               (namespace-syntax-introduce
+                                (datum->syntax #f 'same))
+                               'x))))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
diff --git a/racket/src/racket/src/eval.c b/racket/src/racket/src/eval.c
index fac245e05d..d6b926c382 100644
--- a/racket/src/racket/src/eval.c
+++ b/racket/src/racket/src/eval.c
@@ -3992,10 +3992,12 @@ static void *compile_k(void)
   }
 
   /* Renamings for requires: */
-  if (rename) {
+  if (rename)
     form = scheme_top_introduce(form, genv);
+
+  if (for_eval)
     rib = genv->stx_context;
-  } else
+  else
     rib = NULL;
 
   tl_queue = scheme_null;
@@ -4017,7 +4019,7 @@ static void *compile_k(void)
   else
     frame_scopes = NULL;
 
-  if (for_eval && rename) {
+  if (for_eval) {
     /* For the top-level environment, we "push_introduce" instead of "introduce"
        to avoid ambiguous bindings. */
     form = scheme_stx_push_introduce_module_context(form, genv->stx_context);
@@ -4080,7 +4082,7 @@ static void *compile_k(void)
 	    tl_queue = scheme_append(rl, tl_queue);
 	    form = SCHEME_CAR(tl_queue);
 	    tl_queue = SCHEME_CDR(tl_queue);
-	  } else if (rename)
+	  } else
             form = scheme_stx_push_introduce_module_context(form, genv->stx_context);
 	  break;
 	}
@@ -4911,12 +4913,15 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
     kind = 0; /* expression */
   else if (!for_stx && SAME_OBJ(argv[1], module_symbol)) {
     kind = SCHEME_MODULE_FRAME | SCHEME_USE_SCOPES_TO_NEXT; /* module body */
-    adjust_env = orig_env;
+    if (orig_env->flags & SCHEME_MODULE_FRAME)
+      adjust_env = orig_env;
   } else if (!for_stx && SAME_OBJ(argv[1], module_begin_symbol))
     kind = SCHEME_MODULE_BEGIN_FRAME; /* just inside module for expanding to `#%module-begin` */
   else if (SAME_OBJ(argv[1], top_level_symbol)) {
     kind = SCHEME_TOPLEVEL_FRAME;
     if (catch_lifts < 0) catch_lifts = 0;
+    if (orig_env->flags & SCHEME_TOPLEVEL_FRAME)
+      adjust_env = orig_env;
   } else if (SAME_OBJ(argv[1], expression_symbol))
     kind = 0;
   else if (scheme_proper_list_length(argv[1]) > 0)