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

expander: fix prohibition on redeclaring attachment module instance

Browse Source 
The check worked in the original namespace, but not the target
namespace for an attached instance.

Related to racket/drracket#227
This commit is contained in:
Matthew Flatt 2020-06-29 09:35:41 -06:00
parent e99332af69
commit f38ffc53ed
3 changed files with 22 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/racket-test-core/tests/racket/module.rktl
View File

@ -2707,6 +2707,19 @@ case of module-leve bindings; it doesn't cover local bindings.
(namespace-attach-module-declaration (current-namespace) ''please-attach-me-successfully (make-base-namespace)) (namespace-attach-module-declaration (current-namespace) ''please-attach-me-successfully (make-base-namespace))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure that a module with an attached instance
;; cannot be redeclared in the target namespace
(module module-to-attach-elsewhere racket/base)
(dynamic-require ''module-to-attach-elsewhere #f)
(eval '(module module-to-attach-elsewhere racket/base)) ; to to redeclare here
(let ([ns (make-base-namespace)])
(namespace-attach-module (current-namespace) ''module-to-attach-elsewhere ns)
(err/rt-test (eval '(module module-to-attach-elsewhere racket/base)))
(parameterize ([current-namespace ns])
(err/rt-test (eval '(module module-to-attach-elsewhere racket/base)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that `local-expand` doesn't make module available in a way ;; Check that `local-expand` doesn't make module available in a way
;; that allows the module to import itself ;; that allows the module to import itself

1
racket/src/expander/namespace/module.rkt
View File

@ -289,6 +289,7 @@
[declaration-inspector (module-inspector m)] [declaration-inspector (module-inspector m)]
[inspector (namespace-inspector existing-m-ns)])) [inspector (namespace-inspector existing-m-ns)]))
(define mi (make-module-instance m-ns m)) (define mi (make-module-instance m-ns m))
(set-module-instance-attached?! mi #t)
(cond (cond
[(module-cross-phase-persistent? m) [(module-cross-phase-persistent? m)
(small-hash-set! (namespace-phase-to-namespace m-ns) 0 m-ns) (small-hash-set! (namespace-phase-to-namespace m-ns) 0 m-ns)

11
racket/src/racket/src/startup.inc
View File

@ -14275,6 +14275,8 @@ static const char *startup_source =
"(namespace-module-instances the-struct_0)))" "(namespace-module-instances the-struct_0)))"
" (raise-argument-error 'struct-copy \"namespace?\" the-struct_0)))))" " (raise-argument-error 'struct-copy \"namespace?\" the-struct_0)))))"
"(let-values(((mi_0)(make-module-instance m-ns_0 m_0)))" "(let-values(((mi_0)(make-module-instance m-ns_0 m_0)))"
"(begin"
"(set-module-instance-attached?! mi_0 #t)"
"(if(module-cross-phase-persistent? m_0)" "(if(module-cross-phase-persistent? m_0)"
"(let-values()" "(let-values()"
"(begin" "(begin"
@ -14296,7 +14298,9 @@ static const char *startup_source =
"(small-hash-set!(module-instance-phase-level-to-state mi_0) 0 'started)))" "(small-hash-set!(module-instance-phase-level-to-state mi_0) 0 'started)))"
"(let-values()" "(let-values()"
"(let-values((()" "(let-values((()"
"(begin(small-hash-set!(namespace-phase-to-namespace m-ns_0) 0-phase_0 m-ns_0)(values))))" "(begin"
"(small-hash-set!(namespace-phase-to-namespace m-ns_0) 0-phase_0 m-ns_0)"
"(values))))"
"(let-values((()" "(let-values((()"
"(begin" "(begin"
"(small-hash-set!" "(small-hash-set!"
@ -14309,14 +14313,15 @@ static const char *startup_source =
"(small-hash-set!(module-instance-phase-level-to-state mi_0) 0 'started)" "(small-hash-set!(module-instance-phase-level-to-state mi_0) 0 'started)"
"(values))))" "(values))))"
"(let-values(((at-phase_0)" "(let-values(((at-phase_0)"
"(let-values(((or-part_0)(hash-ref(namespace-module-instances ns_0) 0-phase_0 #f)))" "(let-values(((or-part_0)"
"(hash-ref(namespace-module-instances ns_0) 0-phase_0 #f)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
"(let-values(((at-phase_0)(make-hasheq)))" "(let-values(((at-phase_0)(make-hasheq)))"
"(begin" "(begin"
"(hash-set!(namespace-module-instances ns_0) 0-phase_0 at-phase_0)" "(hash-set!(namespace-module-instances ns_0) 0-phase_0 at-phase_0)"
" at-phase_0))))))" " at-phase_0))))))"
"(hash-set! at-phase_0 name_0 mi_0))))))))))))" "(hash-set! at-phase_0 name_0 mi_0)))))))))))))"
"(define-values" "(define-values"
"(namespace-create-module-instance!)" "(namespace-create-module-instance!)"
"(lambda(ns_0 name_0 0-phase_0 m_0 mpi_0)" "(lambda(ns_0 name_0 0-phase_0 m_0 mpi_0)"