raco exe: fix problem with dynamically resolved relative submodules

This commit is contained in:
Matthew Flatt 2013-11-08 13:21:45 -07:00
parent ae941ac9d8
commit 846c247aa3
3 changed files with 31 additions and 10 deletions

View File

@ -0,0 +1,8 @@
#lang racket/base
(require racket/serialize)
(serializable-struct foo (a b))
(define f (deserialize (serialize (foo 1 2))))
(foo-a f)
(foo-b f)

View File

@ -312,6 +312,14 @@
(path->string (build-path (collection-path "tests" "racket") "embed-me22.rkt")))
(try-exe (mk-dest mred?) "Configure!\nThis is 22.\n" mred?)
;; raco exe on a module with serialization
(system* raco
"exe"
"-o" (path->string (mk-dest mred?))
(if mred? "--gui" "--")
(path->string (build-path (collection-path "tests" "racket") "embed-me23.rkt")))
(try-exe (mk-dest mred?) "1\n2\n" mred?)
;; raco exe --launcher
(system* raco
"exe"

View File

@ -602,7 +602,7 @@
(lambda (m)
(define name (cadr (module-compiled-name m)))
(cons `(submod "." ,name)
(lookup-full-name
(lookup-full-name
(collapse-module-path-index
(module-path-index-join `(submod "." ,name) #f)
filename))))]
@ -612,15 +612,20 @@
(map (lambda (sub-i sub-filename sub-path)
(and (not (and collects-dest
(is-lib-path? sub-path)))
(let-values ([(path base) (module-path-index-split sub-i)])
(and base ; can be #f if path isn't relative
(begin
;; Assert: base should refer to this module:
(let-values ([(path2 base2) (module-path-index-split base)])
(when (or path2 base2)
(error 'embed "unexpected nested module path index")))
(cons path (lookup-full-name sub-filename)))))))
all-file-imports sub-files sub-paths))
(if sub-i
(let-values ([(path base) (module-path-index-split sub-i)])
(and base ; can be #f if path isn't relative
(begin
;; Assert: base should refer to this module:
(let-values ([(path2 base2) (module-path-index-split base)])
(when (or path2 base2)
(error 'embed "unexpected nested module path index")))
(cons path (lookup-full-name sub-filename)))))
;; a run-time path:
(cons sub-path (lookup-full-name sub-filename)))))
(append all-file-imports (map (lambda (p) #f) extra-runtime-paths))
(append sub-files (take extra-files (length extra-runtime-paths)))
(append sub-paths extra-runtime-paths)))
(map get-submod-mapping pre-submods)))])
;; Record the module
(set-box! codes