diff --git a/collects/compiler/doc.txt b/collects/compiler/doc.txt index bd8f37d2bf..78fec46379 100644 --- a/collects/compiler/doc.txt +++ b/collects/compiler/doc.txt @@ -612,11 +612,13 @@ _embedr-sig.ss_ library provides the signature, _compiler:embed^_. The `extra-imports-proc' takes a source pathname and compiled module for each module to be included in the executable. It returns - a list of module path indices for extra modules to be included in - the executable (in addition to the modules that the source module - requires). For example, these modules might correspond to reader - extensions needed to parse a module that will be included as - source. + a list of quoted module paths (absolute, as opposed to relative to + the module) for extra modules to be included in the executable in + addition to the modules that the source module `require's, + `require-for-syntax's, and `require-for-template's. For example, + these modules might correspond to reader extensions needed to parse + a module that will be included as source, as long as the reader is + referenced through an absolute module path. > (make-embedding-executable dest mred? verbose? mod-list literal-file-list literal-sexpr cmdline-list [aux launcher? variant]) diff --git a/collects/compiler/embed-unit.ss b/collects/compiler/embed-unit.ss index 855c53a180..53f924fb74 100644 --- a/collects/compiler/embed-unit.ss +++ b/collects/compiler/embed-unit.ss @@ -397,12 +397,15 @@ [code (let-values ([(imports fs-imports ft-imports) (module-compiled-imports code)]) (let ([all-file-imports (filter (lambda (x) (not (symbol? x))) - (append imports fs-imports ft-imports - (get-extra-imports filename code)))]) + (append imports fs-imports ft-imports))] + [extra-paths (get-extra-imports filename code)]) (let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename))) all-file-imports)] [sub-paths (map (lambda (i) (collapse-module-path-index i module-path)) - all-file-imports)]) + all-file-imports)] + [extra-files (map (lambda (i) (normalize (resolve-module-path-index (module-path-index-join i 'root) + filename))) + extra-paths)]) ;; Get code for imports: (for-each (lambda (sub-filename sub-path) (get-code sub-filename @@ -415,7 +418,8 @@ compiler expand-namespace get-extra-imports)) - sub-files sub-paths) + (append sub-files extra-files) + (append sub-paths extra-paths)) (let ([runtime-paths (parameterize ([current-namespace expand-namespace]) (eval code) @@ -602,7 +606,7 @@ ;; to the embedded modules (write (make-module-name-resolver (filter mod-code (unbox codes)))) ;; Write the extension table and copy module code: - (let* ([l (unbox codes)] + (let* ([l (reverse (unbox codes))] [extensions (filter (lambda (m) (extension? (mod-code m))) l)] [runtimes (filter (lambda (m) (pair? (mod-runtime-paths m))) l)] [table-mod diff --git a/collects/tests/mzscheme/embed-me11-rd.ss b/collects/tests/mzscheme/embed-me11-rd.ss new file mode 100644 index 0000000000..682396a20b --- /dev/null +++ b/collects/tests/mzscheme/embed-me11-rd.ss @@ -0,0 +1,15 @@ +(module embed-me11-rd mzscheme + (provide (rename *read-syntax read-syntax) + (rename *read read)) + + (define (*read port) + `(module embed-me11 mzscheme + (with-output-to-file "stdout" + (lambda () + (printf ,(read port) + ;; Use `getenv' at read time!!! + ,(getenv "ELEVEN"))) + 'append))) + + (define (*read-syntax src port) + (*read port))) diff --git a/collects/tests/mzscheme/embed-me11.ss b/collects/tests/mzscheme/embed-me11.ss new file mode 100644 index 0000000000..f3ab6ee9f7 --- /dev/null +++ b/collects/tests/mzscheme/embed-me11.ss @@ -0,0 +1,2 @@ +#reader(lib "embed-me11-rd.ss" "tests" "mzscheme") +"It goes to ~a!\n" diff --git a/collects/tests/mzscheme/embed.ss b/collects/tests/mzscheme/embed.ss index 9ab5ff962b..0e7b471278 100644 --- a/collects/tests/mzscheme/embed.ss +++ b/collects/tests/mzscheme/embed.ss @@ -347,4 +347,33 @@ (path->string (build-path (collection-path "tests" "mzscheme") "embed-me7.ss"))) (try-exe (mk-dest #t) "plotted\n" #t)) +;; Try including source that needs a reader extension + +(define (try-reader-test mred?) + (define dest (mk-dest mred?)) + (define filename "embed-me11.ss") + (define (flags s) + (string-append "-" (if mred? "Z" "") "mvq" s)) + + (create-embedding-executable + dest + #:modules `((#t (lib ,filename "tests" "mzscheme"))) + #:cmdline `(,(flags "L") ,filename "tests/mzscheme") + #:src-filter (lambda (f) + (let-values ([(base name dir?) (split-path f)]) + (equal? name (string->path filename)))) + #:get-extra-imports (lambda (f code) + (let-values ([(base name dir?) (split-path f)]) + (if (equal? name (string->path filename)) + '((lib "embed-me11-rd.ss" "tests" "mzscheme")) + null))) + #:mred? mred?) + + (putenv "ELEVEN" "eleven") + (try-exe dest "It goes to eleven!\n" mred?) + (putenv "ELEVEN" "done")) + +(try-reader-test #f) +(try-reader-test #t) + (report-errs)