test and fix hook for create-embedding-executable

svn: r6036

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
+   a list of quoted module paths (absolute, as opposed to relative to
-   the executable (in addition to the modules that the source module
+   the module) for extra modules to be included in the executable in
-   requires). For example, these modules might correspond to reader
+   addition to the modules that the source module `require's,
-   extensions needed to parse a module that will be included as
+   `require-for-syntax's, and `require-for-template's. For example,
-   source.
+   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])
 

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
+                                                     (append imports fs-imports ft-imports))]
-                                                             (get-extra-imports filename code)))])
+                           [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

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)))

collects/tests/mzscheme/embed-me11.ss

@@ -0,0 +1,2 @@
+#reader(lib "embed-me11-rd.ss" "tests" "mzscheme")
+"It goes to ~a!\n"

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)