From d19d9eb8f76cf2269d667693be09e3668bbb5c87 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 10 Jun 2010 07:31:53 -0400 Subject: [PATCH 1/7] tweak decompiler to use a different name for boxed locals original commit: 535c8e0a09a2bb9ed34881ed19f81763226c9d12 --- collects/compiler/decompile.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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))))] From aa49f6b2dee4ed3e77901e3ac5049186ba7526a2 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Tue, 15 Jun 2010 12:45:51 -0400 Subject: [PATCH 2/7] Added an empty benchmark to measure Typed Scheme's startup time. original commit: 31d4da6f399acdd6f3f7217594d1f6ae2a7893c2 --- collects/tests/racket/benchmarks/shootout/nothing.rkt | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 collects/tests/racket/benchmarks/shootout/nothing.rkt 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 From 405f94f6fc536e05000ddd4a419991c1f700850e Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Wed, 30 Jun 2010 14:00:09 -0600 Subject: [PATCH 3/7] unstable: removed byte-counting-port.rkt (use open-output-nowhere instead) updated test to verify that open-output-nowhere has same behavior original commit: a543c2137e25931706eca97282541785b75660bf --- collects/compiler/zo-marshal.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt index f3ee228f9d..fba002eecb 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)) From 4fc9ef63169790af053e0b3d56689ed79e2ab4de Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Tue, 6 Jul 2010 10:01:29 -0600 Subject: [PATCH 4/7] [Parallel-Build] remove -u, -j 1 is uniprocessor, SETUP_OPTIONTS => PLT_SETUP_OPTIONS original commit: c9e84f9f672f56ddb6b837483b359af2f4879a08 --- collects/setup/option-sig.rkt | 1 - 1 file changed, 1 deletion(-) diff --git a/collects/setup/option-sig.rkt b/collects/setup/option-sig.rkt index cad8bedaa7..00e9f426bd 100644 --- a/collects/setup/option-sig.rkt +++ b/collects/setup/option-sig.rkt @@ -21,7 +21,6 @@ call-install call-post-install pause-on-errors - parallel-build parallel-workers force-unpacks doc-pdf-dest From 2cd7824462a4df9be38c066ece9ae48acddd04f8 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 7 Jul 2010 06:18:34 -0600 Subject: [PATCH 5/7] fix docs on `raco make --no-deps' Closes PR 11018 original commit: a8062dc37d835939196e7c38e59cc8eae3d15d5c --- collects/compiler/commands/make.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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)))] From d35c8cac36b678d272341fb53ed0bba5d691cbc7 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 8 Jul 2010 16:51:47 -0600 Subject: [PATCH 6/7] fix validation of module .zo exp-time content, and fix zo-marshal original commit: c7c8f56e111f1948242327e71b5c4ce8becd2922 --- collects/compiler/zo-marshal.rkt | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt index fba002eecb..0ff5989dfb 100644 --- a/collects/compiler/zo-marshal.rkt +++ b/collects/compiler/zo-marshal.rkt @@ -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) From 5b322e2bd7073450017a46eccd53d9fda3a73952 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 9 Jul 2010 09:48:41 -0600 Subject: [PATCH 7/7] fix `planet'-path bug in module-name resolver for generated eecutables original commit: 195b37831b802472a24d01df1a629ee465835af6 --- collects/tests/racket/embed-planet-1/alt.rkt | 6 + collects/tests/racket/embed-planet-1/main.rkt | 4 + .../tests/racket/embed-planet-1/other.rkt | 6 + collects/tests/racket/embed-planet-2/main.ss | 5 + .../racket/embed-planet-2/private/sub.rkt | 6 + collects/tests/racket/embed.rktl | 131 +++++++++++++----- 6 files changed, 121 insertions(+), 37 deletions(-) create mode 100644 collects/tests/racket/embed-planet-1/alt.rkt create mode 100644 collects/tests/racket/embed-planet-1/main.rkt create mode 100644 collects/tests/racket/embed-planet-1/other.rkt create mode 100644 collects/tests/racket/embed-planet-2/main.ss create mode 100644 collects/tests/racket/embed-planet-2/private/sub.rkt 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)