From 27f62a591ef04277cf6c4fb4a46ed139cf91ac7d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 4 Feb 2014 20:33:58 -0700 Subject: [PATCH] macro expander repair Fix problem with sealing annotations on module contexts generated to record a context identity. --- .../racket-test/tests/racket/module.rktl | 17 +++++++++++++++++ racket/src/racket/src/syntax.c | 12 ++++-------- 2 files changed, 21 insertions(+), 8 deletions(-) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl index 5299557655..099aaa716a 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/module.rktl @@ -1049,6 +1049,23 @@ (test expected dynamic-require/o '(submod 'm sub) 'x) (test expected dynamic-require/o '(submod 'm sub) 'x)) (test expected-out get-output-string o)) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check handling of module contexts that are kept +;; only for the context's identity (where sealing +;; could be mishandled) + +(let () + (define m '(module m racket + (provide (all-defined-out) def) + (define-syntax def (make-rename-transformer #'define)))) + (define c #f) + (sync (thread ; thread isolates `errortrace` parameter side effects + (lambda () + (parameterize ([current-namespace (make-base-namespace)]) + (namespace-require 'errortrace) + (set! c (compile m)))))) + (write c (open-output-bytes))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/racket/src/racket/src/syntax.c b/racket/src/racket/src/syntax.c index 72e7d0a7c1..6cb408e277 100644 --- a/racket/src/racket/src/syntax.c +++ b/racket/src/racket/src/syntax.c @@ -6366,16 +6366,14 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *stx_datum, identity. */ WRAP_POS l; Scheme_Object *la, *this_set_identity, *set_identity; - int kind, sealed; + int kind; if (SCHEME_RENAMESP(a)) { this_set_identity = ((Module_Renames *)a)->set_identity; kind = ((Module_Renames *)a)->kind; - sealed = ((Module_Renames *)a)->sealed; } else { this_set_identity = ((Module_Renames_Set *)a)->set_identity; kind = ((Module_Renames_Set *)a)->kind; - sealed = ((Module_Renames_Set *)a)->sealed; } if (kind != mzMOD_RENAME_TOPLEVEL) { @@ -6415,14 +6413,12 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *stx_datum, scheme_hash_set(rns, scheme_eof, (Scheme_Object *)identity_map); } - key = scheme_make_pair(scheme_make_integer(kind), - scheme_make_pair(scheme_make_integer(sealed), - this_set_identity)); - + key = scheme_make_pair(scheme_make_integer(kind), this_set_identity); + la = scheme_hash_get(identity_map, key); if (!la) { la = scheme_make_module_rename(scheme_make_integer(0), kind, NULL, NULL, this_set_identity); - ((Module_Renames *)la)->sealed = sealed; + ((Module_Renames *)la)->sealed = STX_SEAL_ALL; scheme_hash_set(identity_map, key, la); }