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
;; can use assoc:
(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
actual-file-path)
(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
actual-file-path))
@ -275,7 +275,7 @@
(define (mod-name m) (list-ref m 3))
(define (mod-prefix m) (list-ref m 4))
(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-module-syms m) (list-ref m 8))
(define (mod-actual-file m) (list-ref m 9))
@ -420,7 +420,7 @@
(set-box! codes
(cons (make-mod filename module-path code
name prefix full-name
null null null
(box null) null null
actual-filename)
(unbox codes)))]
[code
@ -527,7 +527,7 @@
(set-box! codes
(cons (make-mod filename module-path #f
#f #f #f
null null null
(box null) null null
actual-filename)
(unbox codes))))
;; Build up relative module resolutions, relative to this one,
@ -538,34 +538,35 @@
(mod-full-name m)
;; must have been a cycle...
(hash-ref working sub-filename))))]
[mappings (append
(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)
(map (lambda (m)
(define name (cadr (module-compiled-name m)))
(cons `(submod "." ,name)
(lookup-full-name
(collapse-module-path-index
(module-path-index-join `(submod "." ,name) #f)
filename))))
(append pre-submods post-submods)))])
[get-submod-mapping
(lambda (m)
(define name (cadr (module-compiled-name m)))
(cons `(submod "." ,name)
(lookup-full-name
(collapse-module-path-index
(module-path-index-join `(submod "." ,name) #f)
filename))))]
[mappings-box
(box (append
(filter (lambda (p) (and p (cdr p)))
(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))
(map get-submod-mapping pre-submods)))])
;; Record the module
(set-box! codes
(cons (make-mod filename module-path code
name prefix full-name
(filter (lambda (p)
(and p (cdr p)))
mappings)
mappings-box
runtime-paths
;; extract runtime-path module symbols:
(let loop ([runtime-paths runtime-paths]
@ -581,7 +582,11 @@
actual-filename)
(unbox codes)))
;; 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
(set-box! codes
(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")))
(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
(system* raco
"exe"