diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl index a4336c7cc5..698aa7d3de 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -1138,7 +1138,8 @@ v files.} @defproc[(get-info [collection-names (listof string?)] - [#:namespace namespace (or/c namespace? #f) #f]) + [#:namespace namespace (or/c namespace? #f) #f] + [#:bootstrap? bootstrap? any/c #f]) (or/c (symbol? [(-> any)] . -> . any) #f)]{ @@ -1147,7 +1148,8 @@ v named collection and the @racket[namespace] argument.} @defproc[(get-info/full [path path-string?] - [#:namespace namespace (or/c namespace? #f) #f]) + [#:namespace namespace (or/c namespace? #f) #f] + [#:bootstrap? bootstrap? any/c #f]) (or/c (symbol? [(-> any)] . -> . any) #f)]{ @@ -1178,7 +1180,16 @@ v The @filepath{info.rkt} (or @filepath{info.ss}) module is loaded into @racket[namespace] if it is not @racket[#f], or a private, - weakly-held namespace otherwise.} + weakly-held namespace otherwise. + + If @racket[bootstrap?] is true, then + @racket[use-compiled-file-paths] is set to @racket['()] while + reading @filepath{info.rkt} (or @filepath{info.ss}), in case an + existing compiled file is broken. Furthermore, the + @racketmodname[info] and @racketmodname[setup/infotab] modules are + attached to @racket[namespace] from the namespace of + @racket[get-info/full] before attempting to load + @filepath{info.rkt} (or @filepath{info.ss}).} @defproc[(find-relevant-directories (syms (listof symbol?)) diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index cc579cf768..b33012b258 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -149,13 +149,9 @@ (with-handlers ([exn:fail? (λ (x) (log-exn x "getting info") #f)]) - (parameterize ([current-namespace metadata-ns]) - ;; with compiled files on: - (dynamic-require '(submod info reader) #f) - (dynamic-require 'info 0)) - ;; without compiled files: - (parameterize ([use-compiled-file-paths '()]) - (get-info/full pkg-dir #:namespace metadata-ns)))) + (get-info/full pkg-dir + #:namespace metadata-ns + #:bootstrap? #t))) (define (get-metadata metadata-ns pkg-dir key get-default #:checker [checker void]) diff --git a/racket/collects/setup/getinfo.rkt b/racket/collects/setup/getinfo.rkt index 1ef21a2a40..3cc49a7877 100644 --- a/racket/collects/setup/getinfo.rkt +++ b/racket/collects/setup/getinfo.rkt @@ -13,30 +13,30 @@ (define user-infotable (get-planet-cache-path)) ;; get-info : (listof path-or-string) -> info/#f -(define (get-info coll-path #:namespace [ns #f]) +(define (get-info coll-path #:namespace [ns #f] #:bootstrap? [bootstrap? #f]) (get-info/full (apply collection-path (map (lambda (x) (if (path? x) (path->string x) x)) coll-path)) - #:namespace ns)) + #:namespace ns + #:bootstrap? bootstrap?)) -;; HACK: -;; This require is not used. It just requires the file, since -;; otherwise the reader guard below will be invoked on it too, and -;; that will make it throw up. One possible solution for this would -;; be for the security guard to be provided with the file in question. -;; Another would be to force all info files to use `#lang' which means -;; that we'll be able to query their module-language via the -;; `get-info' protocol. -(require (prefix-in !!!HACK!!! setup/infotab/lang/reader) - (prefix-in !!!HACK!!!2 (submod info reader))) +;; These `require's ensure that the `#lang info' readers +;; are loaded, so that no reader guard will be invoked for the reader +;; intself when checking a language via a reader guard, and +(require (only-in setup/infotab) + (only-in info) + (only-in setup/infotab/lang/reader) + (only-in (submod info reader))) ;; get-info/full : path -> info/#f -(define (get-info/full dir #:namespace [ns #f]) - (or (get-info/full/ext dir "rkt" ns) - (get-info/full/ext dir "ss" ns))) +(define (get-info/full dir #:namespace [ns #f] #:bootstrap? [bootstrap? #f]) + (or (get-info/full/ext dir "rkt" ns bootstrap?) + (get-info/full/ext dir "ss" ns bootstrap?))) -(define (get-info/full/ext dir ext ns) +(define (get-info/full/ext dir ext ns bootstrap?) (define file (build-path dir (format "info.~a" ext))) + (define enclosing-ns (variable-reference->namespace + (#%variable-reference))) (define (err fmt . args) (apply error 'get-info (string-append "info file " fmt " in ~a") (append args (list file)))) @@ -48,7 +48,11 @@ (equal? x '(submod setup/infotab reader)) (equal? x '(submod info reader))) x - (err "has illegal #lang or #reader")))]) + (err "has illegal #lang or #reader")))] + [current-namespace + ;; Use this module's namespace; see the `only-in' + ;; `require's above. + enclosing-ns]) (with-input-from-file file (lambda () (begin0 @@ -70,9 +74,20 @@ ;; above (a guard will see other uses of #lang for stuff ;; that is required). ;; We are, however, trusting that the bytecode form of the - ;; file (if any) matches the source. + ;; file (if any) matches the source (except in bootstrap + ;; mode). (parameterize ([current-namespace (or ns (info-namespace))]) - (dynamic-require file '#%info-lookup))] + (if bootstrap? + ;; Attach `info' language modules to target namespace, and + ;; disable the use of compiled bytecode: + (parameterize ([use-compiled-file-paths null]) + (namespace-attach-module enclosing-ns 'setup/infotab) + (namespace-attach-module enclosing-ns 'setup/infotab/lang/reader) + (namespace-attach-module enclosing-ns 'info) + (namespace-attach-module enclosing-ns '(submod info reader)) + (dynamic-require file '#%info-lookup)) + ;; Can use compiled bytecode, etc.: + (dynamic-require file '#%info-lookup)))] [else (err "does not contain a module of the right shape")]))) (define info-namespace @@ -253,8 +268,12 @@ (provide/contract (reset-relevant-directories-state! (-> any)) - (get-info (((listof path-or-string?)) (#:namespace (or/c namespace? #f)) . ->* . (or/c info? boolean?))) - (get-info/full ((path-string?) (#:namespace (or/c namespace? #f)) . ->* . (or/c info? boolean?))) + (get-info (((listof path-or-string?)) + (#:namespace (or/c namespace? #f) #:bootstrap? any/c) + . ->* . (or/c info? boolean?))) + (get-info/full ((path-string?) + (#:namespace (or/c namespace? #f) #:bootstrap? any/c) + . ->* . (or/c info? boolean?))) (find-relevant-directories (->* [(listof symbol?)] [(or/c 'preferred 'all-available 'no-planet 'no-user)] diff --git a/racket/collects/setup/setup-unit.rkt b/racket/collects/setup/setup-unit.rkt index 5e910777a4..93bef871fe 100644 --- a/racket/collects/setup/setup-unit.rkt +++ b/racket/collects/setup/setup-unit.rkt @@ -34,20 +34,25 @@ (define-namespace-anchor anchor) -;; read info files using whatever namespace, .zo-use, and compilation -;; configuration was in place for loading setup, instead of whatever -;; is in place for the collections that setup is processing: -(define getinfo +;; Although we use `#:bootstrap?' mode for reading an "info.rkt" file, +;; which disables the use of compiled bytecode, also use whatever +;; namespace, .zo-use, and compilation configuration was in place for +;; loading setup (just in case), instead of whatever is in place for +;; the collections that setup is processing: +(define make-getinfo (let ([ns (namespace-anchor->empty-namespace anchor)] [compile (current-compile)] [loader (current-load/use-compiled)] [paths (use-compiled-file-paths)]) - (lambda (path) - (parameterize ([current-namespace ns] - [current-compile compile] - [current-load/use-compiled loader] - [use-compiled-file-paths paths]) - (get-info/full path #:namespace ns))))) + (lambda (info-ns) + (lambda (path) + (parameterize ([current-namespace ns] + [current-compile compile] + [current-load/use-compiled loader] + [use-compiled-file-paths paths]) + (get-info/full path + #:namespace info-ns + #:bootstrap? #t)))))) (provide setup@) @@ -221,6 +226,8 @@ (define pkg-path-cache (make-hash)) + (define getinfo (make-getinfo (make-base-namespace))) + (define (make-cc* collection parent path omit-root info-root info-path info-path-mode shadowing-policy main?)