diff --git a/collects/compiler/commands/make.rkt b/collects/compiler/commands/make.rkt index 57ae63c1c4..5cfd96af01 100644 --- a/collects/compiler/commands/make.rkt +++ b/collects/compiler/commands/make.rkt @@ -19,7 +19,7 @@ #:once-each [("--disable-inline") "Disable procedure inlining during compilation" (disable-inlining #t)] - [("--no-deps") "Compile immediate files without updating depdencies" + [("--no-deps") "Compile immediate files without updating dependencies" (disable-deps #t)] [("-p" "--prefix") file "Add elaboration-time prefix file for --no-deps" (prefixes (append (prefixes) (list file)))] diff --git a/collects/compiler/decompile.rkt b/collects/compiler/decompile.rkt index f10d8737ac..b011c988ab 100644 --- a/collects/compiler/decompile.rkt +++ b/collects/compiler/decompile.rkt @@ -221,7 +221,7 @@ (extract-ids! body ids) (let ([vars (for/list ([i (in-range count)] [id (in-vector ids)]) - (or id (gensym 'localv)))]) + (or id (gensym (if boxes? 'localvb 'localv))))]) `(let ,(map (lambda (i) `[,i ,(if boxes? `(#%box ?) '?)]) vars) ,(decompile-expr body globs (append vars stack) closed))))] diff --git a/collects/compiler/sig.rkt b/collects/compiler/sig.rkt index 03b35835a7..a635eb1ab4 100644 --- a/collects/compiler/sig.rkt +++ b/collects/compiler/sig.rkt @@ -79,6 +79,7 @@ compile-collection-zos compile-directory-zos + compile-directory-srcs current-compiler-dynamic-require-wrapper compile-notify-handler)) diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt index f3ee228f9d..0ff5989dfb 100644 --- a/collects/compiler/zo-marshal.rkt +++ b/collects/compiler/zo-marshal.rkt @@ -1,6 +1,6 @@ #lang scheme/base (require compiler/zo-structs - unstable/byte-counting-port + scheme/port scheme/match scheme/contract scheme/local @@ -68,7 +68,7 @@ (out-data (list* max-let-depth prefix (protect-quote form)) (make-out outp (lambda (v) (hash-ref shared v #f)) wrapped)) (values offsets post-shared (file-position outp))) - (define counting-p (make-byte-counting-port)) + (define counting-p (open-output-nowhere)) (define-values (offsets post-shared all-forms-length) (write-all counting-p)) (define all-short? (post-shared . < . #xFFFF)) @@ -479,7 +479,18 @@ [l (cons (lookup-req 1) l)] ; et-requires [l (cons (lookup-req 0) l)] ; requires [l (cons (list->vector body) l)] - [l (cons (list->vector syntax-body) l)] + [l (cons (list->vector + (for/list ([i (in-list syntax-body)]) + (define (maybe-one l) ;; a single symbol is ok + (if (and (pair? l) (null? (cdr l))) + (car l) + l)) + (match i + [(struct def-syntaxes (ids rhs prefix max-let-depth)) + (vector (maybe-one ids) rhs max-let-depth prefix #f)] + [(struct def-for-syntax (ids rhs prefix max-let-depth)) + (vector (maybe-one ids) rhs max-let-depth prefix #t)]))) + l)] [l (append (apply append (map (lambda (l) diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index c7f6670fc3..46ad7d584f 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -2,6 +2,7 @@ (require mzlib/etc scheme/match scheme/list + unstable/struct compiler/zo-structs) (provide zo-parse) @@ -529,7 +530,7 @@ (apply make-prefab-struct k - (map loop (cdr (vector->list (struct->vector v)))))))] + (map loop (struct->list v)))))] [else (add-wrap v)])) ;; Decode sub-elements that have their own wraps: (let-values ([(v counter) (if (exact-integer? (car v)) @@ -551,7 +552,7 @@ (apply make-prefab-struct k - (map loop (cdr (vector->list (struct->vector v)))))))] + (map loop (struct->list v)))))] [else (add-wrap v)])))))) (define (decode-wraps cp w) diff --git a/collects/setup/option-sig.rkt b/collects/setup/option-sig.rkt index efa4c1eb89..00e9f426bd 100644 --- a/collects/setup/option-sig.rkt +++ b/collects/setup/option-sig.rkt @@ -21,6 +21,7 @@ call-install call-post-install pause-on-errors + parallel-workers force-unpacks doc-pdf-dest specific-collections diff --git a/collects/tests/racket/benchmarks/shootout/nothing.rkt b/collects/tests/racket/benchmarks/shootout/nothing.rkt new file mode 100644 index 0000000000..e5a3b58314 --- /dev/null +++ b/collects/tests/racket/benchmarks/shootout/nothing.rkt @@ -0,0 +1,2 @@ +#lang racket/base +1 diff --git a/collects/tests/racket/embed-planet-1/alt.rkt b/collects/tests/racket/embed-planet-1/alt.rkt new file mode 100644 index 0000000000..197192d70e --- /dev/null +++ b/collects/tests/racket/embed-planet-1/alt.rkt @@ -0,0 +1,6 @@ +#lang racket/base +(require "main.ss") + +(with-output-to-file "stdout" + #:exists 'append + (lambda () (displayln "alt"))) diff --git a/collects/tests/racket/embed-planet-1/main.rkt b/collects/tests/racket/embed-planet-1/main.rkt new file mode 100644 index 0000000000..c2ec8174a1 --- /dev/null +++ b/collects/tests/racket/embed-planet-1/main.rkt @@ -0,0 +1,4 @@ +#lang racket/base + +(with-output-to-file "stdout" + (lambda () (displayln "one"))) diff --git a/collects/tests/racket/embed-planet-1/other.rkt b/collects/tests/racket/embed-planet-1/other.rkt new file mode 100644 index 0000000000..98b95b7a4e --- /dev/null +++ b/collects/tests/racket/embed-planet-1/other.rkt @@ -0,0 +1,6 @@ +#lang racket/base +(require (planet racket-tester/p2)) + +(with-output-to-file "stdout" + #:exists 'append + (lambda () (displayln "other"))) diff --git a/collects/tests/racket/embed-planet-2/main.ss b/collects/tests/racket/embed-planet-2/main.ss new file mode 100644 index 0000000000..818ed55316 --- /dev/null +++ b/collects/tests/racket/embed-planet-2/main.ss @@ -0,0 +1,5 @@ +#lang racket/base + + +(with-output-to-file "stdout" + (lambda () (displayln "two"))) diff --git a/collects/tests/racket/embed-planet-2/private/sub.rkt b/collects/tests/racket/embed-planet-2/private/sub.rkt new file mode 100644 index 0000000000..120caf0483 --- /dev/null +++ b/collects/tests/racket/embed-planet-2/private/sub.rkt @@ -0,0 +1,6 @@ +#lang racket/base +(require "../main.ss") + +(with-output-to-file "stdout" + #:exists 'append + (lambda () (displayln "sub"))) diff --git a/collects/tests/racket/embed.rktl b/collects/tests/racket/embed.rktl index 19c392502d..25036d3566 100644 --- a/collects/tests/racket/embed.rktl +++ b/collects/tests/racket/embed.rktl @@ -234,18 +234,19 @@ `(,(flags "ne") "(out \"\u7237...\U1D671\n\")")) (try-exe dest "\uA9, \u7238, and \U1D670\n\u7237...\U1D671\n" mred?)) -(mz-tests #f) -(mz-tests #t) +(define (try-basic) + (mz-tests #f) + (mz-tests #t) -(begin - (prepare mr-dest "embed-me5.rkt") - (make-embedding-executable - mr-dest #t #f - `((#t (lib "embed-me5.rkt" "tests" "racket"))) - null - #f - `("-l" "tests/racket/embed-me5.rkt")) - (try-exe mr-dest "This is 5: #\n" #t)) + (begin + (prepare mr-dest "embed-me5.rkt") + (make-embedding-executable + mr-dest #t #f + `((#t (lib "embed-me5.rkt" "tests" "racket"))) + null + #f + `("-l" "tests/racket/embed-me5.rkt")) + (try-exe mr-dest "This is 5: #\n" #t))) ;; Try the mzc interface: (require setup/dirs @@ -306,8 +307,9 @@ (void))) -(mzc-tests #f) -(mzc-tests #t) +(define (try-mzc) + (mzc-tests #f) + (mzc-tests #t)) (require dynext/file) (define (extension-test mred?) @@ -364,32 +366,34 @@ (path->string (build-path (collection-path "tests" "racket") "embed-me10.rkt"))) (try-exe (mk-dest mred?) "#t\n" mred?))) -(extension-test #f) -(extension-test #t) +(define (try-extension) + (extension-test #f) + (extension-test #t)) -;; A GRacket-specific test with mzc: -(parameterize ([current-directory (find-system-path 'temp-dir)]) - (system* mzc - "--gui-exe" - (path->string (mk-dest #t)) - (path->string (build-path (collection-path "tests" "racket") "embed-me5.rkt"))) - (try-exe (mk-dest #t) "This is 5: #\n" #t)) +(define (try-gracket) + ;; A GRacket-specific test with mzc: + (parameterize ([current-directory (find-system-path 'temp-dir)]) + (system* mzc + "--gui-exe" + (path->string (mk-dest #t)) + (path->string (build-path (collection-path "tests" "racket") "embed-me5.rkt"))) + (try-exe (mk-dest #t) "This is 5: #\n" #t)) -;; Another GRacket-specific: try embedding plot, which has extra DLLs and font files: -(parameterize ([current-directory (find-system-path 'temp-dir)]) - (define direct (build-path (find-system-path 'temp-dir) "direct.ps")) + ;; Another GRacket-specific: try embedding plot, which has extra DLLs and font files: + (parameterize ([current-directory (find-system-path 'temp-dir)]) + (define direct (build-path (find-system-path 'temp-dir) "direct.ps")) - (test #t - system* (build-path (find-console-bin-dir) "mred") - "-qu" - (path->string (build-path (collection-path "tests" "racket") "embed-me7.rkt")) - (path->string direct)) + (test #t + system* (build-path (find-console-bin-dir) "mred") + "-qu" + (path->string (build-path (collection-path "tests" "racket") "embed-me7.rkt")) + (path->string direct)) - (system* mzc - "--gui-exe" - (path->string (mk-dest #t)) - (path->string (build-path (collection-path "tests" "racket") "embed-me7.rkt"))) - (try-exe (mk-dest #t) "plotted\n" #t)) + (system* mzc + "--gui-exe" + (path->string (mk-dest #t)) + (path->string (build-path (collection-path "tests" "racket") "embed-me7.rkt"))) + (try-exe (mk-dest #t) "plotted\n" #t))) ;; Try including source that needs a reader extension @@ -417,7 +421,60 @@ (try-exe dest "It goes to eleven!\n" mred?) (putenv "ELEVEN" "done")) -(try-reader-test #f) -(try-reader-test #t) +(define (try-reader) + (try-reader-test #f) + (try-reader-test #t)) + +;; ---------------------------------------- + +(define planet (build-path (find-console-bin-dir) (if (eq? 'windows (system-type)) + "planet.exe" + "planet"))) + +(define (try-planet) + (system* planet "link" "racket-tester" "p1.plt" "1" "0" + (path->string (collection-path "tests" "racket" "embed-planet-1"))) + (system* planet "link" "racket-tester" "p2.plt" "2" "2" + (path->string (collection-path "tests" "racket" "embed-planet-2"))) + + (let ([go (lambda (path expected) + (printf "Trying planet ~s...\n" path) + (let ([tmp (make-temporary-file)] + [dest (mk-dest #f)]) + (with-output-to-file tmp + #:exists 'truncate + (lambda () + (printf "#lang racket/base (require ~s)\n" path))) + (system* mzc "--exe" (path->string dest) (path->string tmp)) + (try-exe dest expected #f) + + (delete-directory/files dest) + + (delete-file tmp)))]) + (go '(planet racket-tester/p1) "one\n") + (go '(planet "racket-tester/p1:1") "one\n") + (go '(planet "racket-tester/p1:1:0") "one\n") + (go '(planet "racket-tester/p1:1:0/main.ss") "one\n") + (go '(planet racket-tester/p2) "two\n") + + (go '(planet racket-tester/p1/alt) "one\nalt\n") + (go '(planet racket-tester/p1/other) "two\nother\n") + (go '(planet "private/sub.rkt" ("racket-tester" "p2.plt" 2 0)) "two\nsub\n") + + (void)) + + (system* planet "unlink" "racket-tester" "p1.plt" "1" "0") + (system* planet "unlink" "racket-tester" "p2.plt" "2" "2")) + +;; ---------------------------------------- + +(try-basic) +(try-mzc) +(try-extension) +(try-gracket) +(try-reader) +(try-planet) + +;; ---------------------------------------- (report-errs)