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

adjust contract-out to use fresh scopes for mangled identifiers

Browse Source 
closes #2469
This commit is contained in:
Robby Findler 2019-03-15 22:11:16 -05:00
parent 397be50113
commit ce324be9f8
2 changed files with 27 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/racket-test/tests/racket/contract/contract-out.rkt
View File

@ -1230,6 +1230,18 @@
(eval '(dynamic-require ''provide/contract66-m2 #f)))
"provide/contract66-m1")
(test/spec-passed
'provide/contract67
'(let ()
(eval '(module provide/contract67-a racket/base
(require racket/contract/base)
(struct stream (x [y #:mutable]))
(provide (contract-out (struct stream ([x any/c] [y any/c]))))))
(eval '(module provide/contract67-b racket/base
(require 'provide/contract67-a racket/contract/base)
(provide (contract-out (struct stream ([x any/c] [y any/c]))))))))
(contract-error-test
'provide/contract-struct-out
#'(begin

25
racket/collects/racket/contract/private/provide.rkt
View File

@ -460,6 +460,8 @@
[(_ p/c-ele ...)
(let ()
(define mangled-id-scope (make-syntax-introducer))
;; ids : table[id -o> (listof id)]
;; code-for-each-clause adds identifiers to this map.
;; when it binds things; they are then used to signal
@ -710,9 +712,10 @@
#t))]
[mutator-ids (reverse (list-ref the-struct-info 4))] ;; (listof (union #f identifier))
[field-contract-ids (map (λ (field-name field-contract)
(a:mangle-id "provide/contract-field-contract"
field-name
struct-name))
(mangled-id-scope
(a:mangle-id "provide/contract-field-contract"
field-name
struct-name)))
field-names
field-contracts)]
[struct:struct-name
@ -1083,11 +1086,12 @@
(syntax code)))
(define (id-for-one-id user-rename-id reflect-id id [mangle-for-maker? #f])
((if mangle-for-maker?
a:mangle-id-for-maker
a:mangle-id)
"provide/contract-id"
(or user-rename-id reflect-id id)))
(mangled-id-scope
((if mangle-for-maker?
a:mangle-id-for-maker
a:mangle-id)
"provide/contract-id"
(or user-rename-id reflect-id id))))
(define pos-module-source-id
;; Avoid context on this identifier, since it will be defined
@ -1118,8 +1122,9 @@
(free-identifier-mapping-put!
struct-id-mapping
a
(a:mangle-id "provide/contract-struct-expandsion-info-id"
a))
(mangled-id-scope
(a:mangle-id "provide/contract-struct-expandsion-info-id"
a)))
(define parent-selectors
(if parent
(let ([parent-selectors (list-ref (extract-struct-info (syntax-local-value parent))