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

fix yet more ss<->rkt problems that interfered with *SL executables

Browse Source 
Closes PR 11106

original commit: 76c3c76214
This commit is contained in:
Matthew Flatt 2010-08-30 09:17:21 -06:00
parent f38ec26ea5
commit 1b3843bd9c
2 changed files with 38 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/tests/racket/embed-me12-rd.ss Normal file
View File

@ -0,0 +1,15 @@
(module embed-me11-rd mzscheme
(provide (rename *read-syntax read-syntax)
(rename *read read))
(define (*read port)
`(module embed-me11 mzscheme
(with-output-to-file "stdout"
(lambda ()
(printf ,(read port)
;; Use `getenv' at read time!!!
,(getenv "ELEVEN")))
'append)))
(define (*read-syntax src port)
(*read port)))

30
collects/tests/racket/embed.rktl
View File

@ -397,23 +397,36 @@
;; Try including source that needs a reader extension ;; Try including source that needs a reader extension
(define (try-reader-test mred?) (define (try-reader-test 12? mred? ss-file? ss-reader?)
;; actual "11" files use ".rkt", actual "12" files use ".ss"
(define dest (mk-dest mred?)) (define dest (mk-dest mred?))
(define filename "embed-me11.rkt") (define filename (format (if ss-file?
"embed-me~a.ss"
"embed-me~a.rkt")
(if 12? "12" "11")))
(define (flags s) (define (flags s)
(string-append "-" s)) (string-append "-" s))
(printf "Trying ~s ~s ~s ~s...\n" (if 12? "12" "11") mred? ss-file? ss-reader?)
(create-embedding-executable (create-embedding-executable
dest dest
#:modules `((#t (lib ,filename "tests" "racket"))) #:modules `((#t (lib ,filename "tests" "racket")))
#:cmdline `(,(flags "l") ,(string-append "tests/racket/" filename)) #:cmdline `(,(flags "l") ,(string-append "tests/racket/" filename))
#:src-filter (lambda (f) #:src-filter (lambda (f)
(let-values ([(base name dir?) (split-path f)]) (let-values ([(base name dir?) (split-path f)])
(equal? name (string->path filename)))) (equal? name (path-replace-suffix (string->path filename)
(if 12? #".ss" #".rkt")))))
#:get-extra-imports (lambda (f code) #:get-extra-imports (lambda (f code)
(let-values ([(base name dir?) (split-path f)]) (let-values ([(base name dir?) (split-path f)])
(if (equal? name (string->path filename)) (if (equal? name (path-replace-suffix (string->path filename)
'((lib "embed-me11-rd.rkt" "tests" "racket")) (if 12? #".ss" #".rkt")))
`((lib ,(format (if ss-reader?
"embed-me~a-rd.ss"
"embed-me~a-rd.rkt")
(if 12? "12" "11"))
"tests"
"racket"))
null))) null)))
#:mred? mred?) #:mred? mred?)
@ -422,8 +435,11 @@
(putenv "ELEVEN" "done")) (putenv "ELEVEN" "done"))
(define (try-reader) (define (try-reader)
(try-reader-test #f) (for ([12? (in-list '(#f #t))])
(try-reader-test #t)) (try-reader-test 12? #f #f #f)
(try-reader-test 12? #t #f #f)
(try-reader-test 12? #f #t #f)
(try-reader-test 12? #f #f #t)))
;; ---------------------------------------- ;; ----------------------------------------