suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco exe test: add no-GUI mode

Browse Source
This commit is contained in:
Matthew Flatt 2019-06-25 21:03:52 -06:00
parent a0023d5797
commit f97342b138
1 changed files with 49 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
pkgs/compiler-test/tests/compiler/embed/test.rkt
View File

@ -8,6 +8,9 @@
compiler/distribute compiler/distribute
(only-in pkg/lib installed-pkg-names)) (only-in pkg/lib installed-pkg-names))
(define skip-mred? (and (getenv "PLT_TEST_NO_GUI")
#t))
(define (test expect f/label . args) (define (test expect f/label . args)
(define r (apply (if (procedure? f/label) (define r (apply (if (procedure? f/label)
f/label f/label
@ -46,15 +49,15 @@
(define (call-with-retries thunk) (define (call-with-retries thunk)
(let loop ([sleep-time 0.01]) (let loop ([sleep-time 0.01])
(with-handlers ([exn:fail:filesystem? (lambda (exn) (with-handlers* ([exn:fail:filesystem? (lambda (exn)
;; Accommodate Windows background tasks, ;; Accommodate Windows background tasks,
;; like anti-virus software and indexing, ;; like anti-virus software and indexing,
;; that can prevent an ".exe" from being deleted ;; that can prevent an ".exe" from being deleted
(if (= sleep-time 1.0) (if (= sleep-time 1.0)
(raise exn) (raise exn)
(begin (begin
(sleep sleep-time) (sleep sleep-time)
(loop (* 2 sleep-time)))))]) (loop (* 2 sleep-time)))))])
(thunk)))) (thunk))))
(define (prepare exe src) (define (prepare exe src)
@ -290,16 +293,17 @@
(define (try-basic) (define (try-basic)
(mz-tests #f) (mz-tests #f)
(mz-tests #t) (unless skip-mred?
(begin (mz-tests #t)
(prepare mr-dest "embed-me5.rkt") (begin
(make-embedding-executable (prepare mr-dest "embed-me5.rkt")
mr-dest #t #f (make-embedding-executable
`((#t (lib "embed-me5.rkt" "tests" "compiler" "embed"))) mr-dest #t #f
null `((#t (lib "embed-me5.rkt" "tests" "compiler" "embed")))
#f null
`("-l" "tests/compiler/embed/embed-me5.rkt")) #f
(try-exe mr-dest "This is 5: #<class:button%>\n" #t))) `("-l" "tests/compiler/embed/embed-me5.rkt"))
(try-exe mr-dest "This is 5: #<class:button%>\n" #t))))
(define (try-embedded-dlls) (define (try-embedded-dlls)
(prepare mz-dest "embed-me1.rkt") (prepare mz-dest "embed-me1.rkt")
@ -312,15 +316,16 @@
'((embed-dlls? . #t))) '((embed-dlls? . #t)))
(try-exe mz-dest "This is 1\n" #t) (try-exe mz-dest "This is 1\n" #t)
(prepare mr-dest "embed-me5.rkt") (unless skip-mred?
(make-embedding-executable (prepare mr-dest "embed-me5.rkt")
mr-dest #t #f (make-embedding-executable
`((#t (lib "embed-me5.rkt" "tests" "compiler" "embed"))) mr-dest #t #f
'() `((#t (lib "embed-me5.rkt" "tests" "compiler" "embed")))
#f '()
`("-l" "tests/compiler/embed/embed-me5.rkt") #f
'((embed-dlls? . #t))) `("-l" "tests/compiler/embed/embed-me5.rkt")
(try-exe mr-dest "This is 5: #<class:button%>\n" #t)) '((embed-dlls? . #t)))
(try-exe mr-dest "This is 5: #<class:button%>\n" #t)))
;; Try the raco interface: ;; Try the raco interface:
(require setup/dirs (require setup/dirs
@ -517,7 +522,8 @@
(define (try-mzc) (define (try-mzc)
(mzc-tests #f) (mzc-tests #f)
(short-mzc-tests #t)) (unless skip-mred?
(short-mzc-tests #t)))
(require dynext/file) (require dynext/file)
(define (extension-test mred?) (define (extension-test mred?)
@ -576,16 +582,18 @@
(define (try-extension) (define (try-extension)
(extension-test #f) (extension-test #f)
(extension-test #t)) (unless skip-mred?
(extension-test #t)))
(define (try-gracket) (define (try-gracket)
;; A GRacket-specific test with mzc: (unless skip-mred?
(parameterize ([current-directory (find-system-path 'temp-dir)]) ;; A GRacket-specific test with mzc:
(system+ mzc (parameterize ([current-directory (find-system-path 'temp-dir)])
"--gui-exe" (system+ mzc
(path->string (mk-dest #t)) "--gui-exe"
(path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me5.rkt"))) (path->string (mk-dest #t))
(try-exe (mk-dest #t) "This is 5: #<class:button%>\n" #t))) (path->string (build-path (collection-path "tests" "compiler" "embed") "embed-me5.rkt")))
(try-exe (mk-dest #t) "This is 5: #<class:button%>\n" #t))))
;; Try including source that needs a reader extension ;; Try including source that needs a reader extension
@ -630,7 +638,8 @@
(define (try-reader) (define (try-reader)
(for ([12? (in-list '(#f #t))]) (for ([12? (in-list '(#f #t))])
(try-reader-test 12? #f #f #f) (try-reader-test 12? #f #f #f)
(try-reader-test 12? #t #f #f) (unless skip-mred?
(try-reader-test 12? #t #f #f))
(try-reader-test 12? #f #t #f) (try-reader-test 12? #f #t #f)
(try-reader-test 12? #f #f #t))) (try-reader-test 12? #f #f #t)))
@ -805,4 +814,3 @@
(parameterize ([read-accept-reader #t] (parameterize ([read-accept-reader #t]
[current-namespace (make-base-namespace)]) [current-namespace (make-base-namespace)])
(eval (read (open-input-string "#lang racket 10"))))) (eval (read (open-input-string "#lang racket 10")))))