From 6325cd0945f5c9a21eda96b99a77f6541db4e349 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 17 Oct 2012 16:14:29 -0600 Subject: [PATCH] fix `raco exe' for `module+' submodules Closes PR 13116 Merge to v5.3.1 (cherry picked from commit e1a6d2b07d263ababc89642ab78f6e17fce19be4) --- collects/compiler/embed-unit.rkt | 65 +++++++++++++++------------- collects/tests/racket/embed-me20.rkt | 7 +++ collects/tests/racket/embed.rktl | 8 ++++ 3 files changed, 50 insertions(+), 30 deletions(-) create mode 100644 collects/tests/racket/embed-me20.rkt diff --git a/collects/compiler/embed-unit.rkt b/collects/compiler/embed-unit.rkt index 3b1d118e62..c162ff3fcb 100644 --- a/collects/compiler/embed-unit.rkt +++ b/collects/compiler/embed-unit.rkt @@ -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 diff --git a/collects/tests/racket/embed-me20.rkt b/collects/tests/racket/embed-me20.rkt new file mode 100644 index 0000000000..d4b8fe1586 --- /dev/null +++ b/collects/tests/racket/embed-me20.rkt @@ -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)) diff --git a/collects/tests/racket/embed.rktl b/collects/tests/racket/embed.rktl index 47c5183ea7..39da0cdd83 100644 --- a/collects/tests/racket/embed.rktl +++ b/collects/tests/racket/embed.rktl @@ -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"