raco exe: yet another submodule repair

Closes PR 13410

original commit: e66cd6f9c7
This commit is contained in:
Matthew Flatt 2013-01-05 09:02:23 -07:00
parent 3b9e13b38f
commit 3c01f128b9
6 changed files with 58 additions and 11 deletions

View File

@ -0,0 +1,4 @@
;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-advanced-reader.ss" "lang")((modname ex) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
10

View File

@ -0,0 +1,4 @@
;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-beginner-reader.ss" "lang")((modname ex) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
10

View File

@ -0,0 +1,4 @@
;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-beginner-abbr-reader.ss" "lang")((modname ex) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
10

View File

@ -0,0 +1,4 @@
;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-reader.ss" "lang")((modname ex) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
10

View File

@ -0,0 +1,4 @@
;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname ex) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
10

View File

@ -45,7 +45,8 @@
(define (try-one-exe exe expect mred?) (define (try-one-exe exe expect mred?)
(printf "Running ~a\n" exe) (printf "Running ~a\n" exe)
(let ([plthome (getenv "PLTHOME")] (let ([plthome (getenv "PLTHOME")]
[collects (getenv "PLTCOLLECTS")]) [collects (getenv "PLTCOLLECTS")]
[out (open-output-string)])
;; Try to hide usual collections: ;; Try to hide usual collections:
(when plthome (when plthome
(putenv "PLTHOME" (path->string (build-path (find-system-path 'temp-dir) "NOPE")))) (putenv "PLTHOME" (path->string (build-path (find-system-path 'temp-dir) "NOPE"))))
@ -55,23 +56,29 @@
(parameterize ([current-directory (find-system-path 'temp-dir)]) (parameterize ([current-directory (find-system-path 'temp-dir)])
(when (file-exists? "stdout") (when (file-exists? "stdout")
(delete-file "stdout")) (delete-file "stdout"))
(test #t (let ([path (if (and mred? (eq? 'macosx (system-type)))
system* (if (and mred? (eq? 'macosx (system-type)))
(let-values ([(base name dir?) (split-path exe)]) (let-values ([(base name dir?) (split-path exe)])
(build-path exe "Contents" "MacOS" (build-path exe "Contents" "MacOS"
(path-replace-suffix name #""))) (path-replace-suffix name #"")))
exe))) exe)])
(test #t
path
(parameterize ([current-output-port out])
(system* path)))))
(when plthome (when plthome
(putenv "PLTHOME" plthome)) (putenv "PLTHOME" plthome))
(when collects (when collects
(putenv "PLTCOLLECTS" collects)) (putenv "PLTCOLLECTS" collects))
(test expect with-input-from-file (build-path (find-system-path 'temp-dir) "stdout") (let ([stdout-file (build-path (find-system-path 'temp-dir) "stdout")])
(lambda () (read-string 5000))))) (if (file-exists? stdout-file)
(test expect with-input-from-file stdout-file
(lambda () (read-string 5000)))
(test expect get-output-string out)))))
(define (try-exe exe expect mred? [dist-hook void] #:dist? [dist? #t] . collects) (define (try-exe exe expect mred? [dist-hook void] #:dist? [dist? #t] . collects)
(try-one-exe exe expect mred?) (try-one-exe exe expect mred?)
(when dist? (when dist?
;; Build a distirbution directory, and try that, too: ;; Build a distribution directory, and try that, too:
(printf " ... from distribution ...\n") (printf " ... from distribution ...\n")
(when (directory-exists? dist-dir) (when (directory-exists? dist-dir)
(delete-directory/files dist-dir)) (delete-directory/files dist-dir))
@ -522,12 +529,32 @@
;; ---------------------------------------- ;; ----------------------------------------
(define (try-*sl)
(define (try-one src)
(printf "Trying ~a...\n" src)
(define exe (path->string (mk-dest #f)))
(system* raco
"exe"
"-o" exe
"--"
(path->string (build-path (collection-path "tests" "racket") src)))
(try-exe exe "10\n" #f))
(try-one "embed-bsl.rkt")
(try-one "embed-bsla.rkt")
(try-one "embed-isl.rkt")
(try-one "embed-isll.rkt")
(try-one "embed-asl.rkt"))
;; ----------------------------------------
(try-basic) (try-basic)
(try-mzc) (try-mzc)
(try-extension) (try-extension)
(try-gracket) (try-gracket)
(try-reader) (try-reader)
(try-planet) (try-planet)
(try-*sl)
;; ---------------------------------------- ;; ----------------------------------------