suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

macro expander repair

Browse Source 
Fix problem with sealing annotations on module contexts generated
to record a context identity.
This commit is contained in:
Matthew Flatt 2014-02-04 20:33:58 -07:00
parent b31f309de1
commit 27f62a591e
2 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pkgs/racket-pkgs/racket-test/tests/racket/module.rktl
View File

@ -1050,6 +1050,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)) (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)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)

10
racket/src/racket/src/syntax.c
View File

@ -6366,16 +6366,14 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *stx_datum,
identity. */ identity. */
WRAP_POS l; WRAP_POS l;
Scheme_Object *la, *this_set_identity, *set_identity; Scheme_Object *la, *this_set_identity, *set_identity;
int kind, sealed; int kind;
if (SCHEME_RENAMESP(a)) { if (SCHEME_RENAMESP(a)) {
this_set_identity = ((Module_Renames *)a)->set_identity; this_set_identity = ((Module_Renames *)a)->set_identity;
kind = ((Module_Renames *)a)->kind; kind = ((Module_Renames *)a)->kind;
sealed = ((Module_Renames *)a)->sealed;
} else { } else {
this_set_identity = ((Module_Renames_Set *)a)->set_identity; this_set_identity = ((Module_Renames_Set *)a)->set_identity;
kind = ((Module_Renames_Set *)a)->kind; kind = ((Module_Renames_Set *)a)->kind;
sealed = ((Module_Renames_Set *)a)->sealed;
} }
if (kind != mzMOD_RENAME_TOPLEVEL) { 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); scheme_hash_set(rns, scheme_eof, (Scheme_Object *)identity_map);
} }
key = scheme_make_pair(scheme_make_integer(kind), key = scheme_make_pair(scheme_make_integer(kind), this_set_identity);
scheme_make_pair(scheme_make_integer(sealed),
this_set_identity));
la = scheme_hash_get(identity_map, key); la = scheme_hash_get(identity_map, key);
if (!la) { if (!la) {
la = scheme_make_module_rename(scheme_make_integer(0), kind, NULL, NULL, this_set_identity); 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); scheme_hash_set(identity_map, key, la);
} }