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)