suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix raco exe' for module+' submodules

Browse Source 
Closes PR 13116

Merge to v5.3.1
(cherry picked from commit e1a6d2b07d)
This commit is contained in:
Matthew Flatt 2012-10-17 16:14:29 -06:00 committed by Ryan Culpepper
parent d76bdd5919
commit 6325cd0945
3 changed files with 50 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
collects/compiler/embed-unit.rkt
View File

@ -261,11 +261,11 @@
;; Represent modules with lists starting with the filename, so we ;; Represent modules with lists starting with the filename, so we
;; can use assoc: ;; can use assoc:
(define (make-mod normal-file-path normal-module-path (define (make-mod normal-file-path normal-module-path
code name prefix full-name relative-mappings code name prefix full-name relative-mappings-box
runtime-paths runtime-module-syms runtime-paths runtime-module-syms
actual-file-path) actual-file-path)
(list normal-file-path normal-module-path code (list normal-file-path normal-module-path code
name prefix full-name relative-mappings name prefix full-name relative-mappings-box
runtime-paths runtime-module-syms runtime-paths runtime-module-syms
actual-file-path)) actual-file-path))
@ -275,7 +275,7 @@
(define (mod-name m) (list-ref m 3)) (define (mod-name m) (list-ref m 3))
(define (mod-prefix m) (list-ref m 4)) (define (mod-prefix m) (list-ref m 4))
(define (mod-full-name m) (list-ref m 5)) (define (mod-full-name m) (list-ref m 5))
(define (mod-mappings m) (list-ref m 6)) (define (mod-mappings m) (unbox (list-ref m 6)))
(define (mod-runtime-paths m) (list-ref m 7)) (define (mod-runtime-paths m) (list-ref m 7))
(define (mod-runtime-module-syms m) (list-ref m 8)) (define (mod-runtime-module-syms m) (list-ref m 8))
(define (mod-actual-file m) (list-ref m 9)) (define (mod-actual-file m) (list-ref m 9))
@ -420,7 +420,7 @@
(set-box! codes (set-box! codes
(cons (make-mod filename module-path code (cons (make-mod filename module-path code
name prefix full-name name prefix full-name
null null null (box null) null null
actual-filename) actual-filename)
(unbox codes)))] (unbox codes)))]
[code [code
@ -527,7 +527,7 @@
(set-box! codes (set-box! codes
(cons (make-mod filename module-path #f (cons (make-mod filename module-path #f
#f #f #f #f #f #f
null null null (box null) null null
actual-filename) actual-filename)
(unbox codes)))) (unbox codes))))
;; Build up relative module resolutions, relative to this one, ;; Build up relative module resolutions, relative to this one,
@ -538,34 +538,35 @@
(mod-full-name m) (mod-full-name m)
;; must have been a cycle... ;; must have been a cycle...
(hash-ref working sub-filename))))] (hash-ref working sub-filename))))]
[mappings (append [get-submod-mapping
(map (lambda (sub-i sub-filename sub-path) (lambda (m)
(and (not (and collects-dest (define name (cadr (module-compiled-name m)))
(is-lib-path? sub-path))) (cons `(submod "." ,name)
(let-values ([(path base) (module-path-index-split sub-i)]) (lookup-full-name
(and base ; can be #f if path isn't relative (collapse-module-path-index
(begin (module-path-index-join `(submod "." ,name) #f)
;; Assert: base should refer to this module: filename))))]
(let-values ([(path2 base2) (module-path-index-split base)]) [mappings-box
(when (or path2 base2) (box (append
(error 'embed "unexpected nested module path index"))) (filter (lambda (p) (and p (cdr p)))
(cons path (lookup-full-name sub-filename))))))) (map (lambda (sub-i sub-filename sub-path)
all-file-imports sub-files sub-paths) (and (not (and collects-dest
(map (lambda (m) (is-lib-path? sub-path)))
(define name (cadr (module-compiled-name m))) (let-values ([(path base) (module-path-index-split sub-i)])
(cons `(submod "." ,name) (and base ; can be #f if path isn't relative
(lookup-full-name (begin
(collapse-module-path-index ;; Assert: base should refer to this module:
(module-path-index-join `(submod "." ,name) #f) (let-values ([(path2 base2) (module-path-index-split base)])
filename)))) (when (or path2 base2)
(append pre-submods post-submods)))]) (error 'embed "unexpected nested module path index")))
(cons path (lookup-full-name sub-filename)))))))
all-file-imports sub-files sub-paths))
(map get-submod-mapping pre-submods)))])
;; Record the module ;; Record the module
(set-box! codes (set-box! codes
(cons (make-mod filename module-path code (cons (make-mod filename module-path code
name prefix full-name name prefix full-name
(filter (lambda (p) mappings-box
(and p (cdr p)))
mappings)
runtime-paths runtime-paths
;; extract runtime-path module symbols: ;; extract runtime-path module symbols:
(let loop ([runtime-paths runtime-paths] (let loop ([runtime-paths runtime-paths]
@ -581,7 +582,11 @@
actual-filename) actual-filename)
(unbox codes))) (unbox codes)))
;; Add code for post submodules: ;; Add code for post submodules:
(for-each get-one-submodule-code post-submods)))))))] (for-each get-one-submodule-code post-submods)
;; Add post-submodule mappings:
(set-box! mappings-box
(append (unbox mappings-box)
(map get-submod-mapping post-submods)))))))))]
[else [else
(set-box! codes (set-box! codes
(cons (make-mod filename module-path code (cons (make-mod filename module-path code

7
collects/tests/racket/embed-me20.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang racket/base
;; like "embed-me16.rkt" using `module+'
(module+ main
(with-output-to-file "stdout"
(lambda () (printf "This is 20.\n"))
#:exists 'append))

8
collects/tests/racket/embed.rktl
View File

@ -288,6 +288,14 @@
(path->string (build-path (collection-path "tests" "racket") "embed-me16.rkt"))) (path->string (build-path (collection-path "tests" "racket") "embed-me16.rkt")))
(try-exe (mk-dest mred?) "This is 16.\n" mred?) (try-exe (mk-dest mred?) "This is 16.\n" mred?)
;; raco exe on a module with a `main' submodule+
(system* raco
"exe"
"-o" (path->string (mk-dest mred?))
(if mred? "--gui" "--")
(path->string (build-path (collection-path "tests" "racket") "embed-me20.rkt")))
(try-exe (mk-dest mred?) "This is 20.\n" mred?)
;;raco exe --launcher ;;raco exe --launcher
(system* raco (system* raco
"exe" "exe"