From 37dde6dc1e23b22f63acaa75ae1ab4f6fb7ee675 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 23 May 2018 12:30:52 -0600 Subject: [PATCH] expander: fix related to `(local-expand .... 'module-begin ....)` When a module body is expanded with `local-expand`, then submodules can remain declared even if the submodule is discarded in the final expansion. Since that's the way it has always been, leave it that way. But also guard against a way of generating an import cycle via those leftover declarations. --- .../racket-test-core/tests/racket/module.rktl | 21 +++++++++++++++ racket/src/expander/namespace/module.rkt | 2 ++ racket/src/racket/src/startup.inc | 26 ++++++++++++++----- 3 files changed, 43 insertions(+), 6 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/module.rktl b/pkgs/racket-test-core/tests/racket/module.rktl index ad03e58865..6d0ff8f051 100644 --- a/pkgs/racket-test-core/tests/racket/module.rktl +++ b/pkgs/racket-test-core/tests/racket/module.rktl @@ -2596,6 +2596,27 @@ case of module-leve bindings; it doesn't cover local bindings. (namespace-attach-module-declaration (current-namespace) ''please-attach-me-successfully (make-base-namespace)) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check that `local-expand` doesn't make module available in a way +;; that allows the module to import itself + +(err/rt-test + (eval + '(module use-submodule-tries-to-import-itself racket/base + (module mb racket/base + (require (for-syntax racket/base)) + (provide (except-out (all-from-out racket/base) + #%module-begin) + (rename-out [module-begin #%module-begin])) + (define-syntax (module-begin stx) + (syntax-case stx () + [(_ a b) + #'(#%module-begin b)]))) + + (module use (submod ".." mb) + (module* m racket/base) + (require (submod "." m "..")))))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/racket/src/expander/namespace/module.rkt b/racket/src/expander/namespace/module.rkt index 123c26c7b1..586e7c389f 100644 --- a/racket/src/expander/namespace/module.rkt +++ b/racket/src/expander/namespace/module.rkt @@ -422,6 +422,8 @@ (module-instance-made-available? mi))) ;; Something to do... (define m (module-instance-module mi)) + (unless m + (error 'require "import cycle detected; trying to run module being expanded")) (define mpi (namespace-mpi m-ns)) (define phase-shift instance-phase) ; instance phase = phase shift (define bulk-binding-registry (namespace-bulk-binding-registry m-ns)) diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index b2db52b92d..6fbad2785b 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -13876,13 +13876,23 @@ static const char *startup_source = "(void)" "(let-values()" "(let-values(((m_9)(module-instance-module mi_7)))" +"(let-values((()" +"(begin" +"(if m_9" +"(void)" +"(let-values()" +"(error" +" 'require" +" \"import cycle detected; trying to run module being expanded\")))" +"(values))))" "(let-values(((mpi_19)(namespace-mpi m-ns_5)))" "(let-values(((phase-shift_3) instance-phase_4))" -"(let-values(((bulk-binding-registry_3)(namespace-bulk-binding-registry m-ns_5)))" +"(let-values(((bulk-binding-registry_3)" +"(namespace-bulk-binding-registry m-ns_5)))" "(begin" "(if(hash-ref seen_18 mi_7 #f)" "(let-values()" -" (error 'require \"import cycle detected during module instantiation\"))" +" (error 'require \"import cycle detected during module instantiation\"))" "(void))" "(if(module-instance-shifted-requires mi_7)" "(void)" @@ -13964,7 +13974,8 @@ static const char *startup_source = " null" " lst_61))))))" " fold-var_45))))" -"(values fold-var_46)))))" +"(values" +" fold-var_46)))))" "(if(not #f)" "(for-loop_83 fold-var_44 rest_27)" " fold-var_44)))" @@ -13982,7 +13993,8 @@ static const char *startup_source = "(begin" " 'for-loop" "(if(pair? lst_64)" -"(let-values(((phase+mpis_1)(unsafe-car lst_64))" +"(let-values(((phase+mpis_1)" +"(unsafe-car lst_64))" "((rest_29)(unsafe-cdr lst_64)))" "(let-values((()" "(let-values()" @@ -14062,7 +14074,9 @@ static const char *startup_source = "(void))))" "(values)))))" "(values)))))" -"(if(not #f)(for-loop_85 rest_29)(values))))" +"(if(not #f)" +"(for-loop_85 rest_29)" +"(values))))" "(values))))))" " for-loop_85)" " lst_63)))" @@ -14204,7 +14218,7 @@ static const char *startup_source = "(small-hash-set!" "(module-instance-phase-level-to-state mi_7)" " run-phase-level_0" -" 'started))))))))))))))))))))))))" +" 'started)))))))))))))))))))))))))" "(define-values" "(namespace-visit-available-modules!)" "(let-values(((namespace-visit-available-modules!130_0)"