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

Merge branch 'master' of git.racket-lang.org:plt

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-03 13:02:18 -04:00
commit d022260a69
2 changed files with 29 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/meta/drdr/metadata.ss
View File

@ -3,21 +3,23 @@
"dirstruct.ss" "dirstruct.ss"
"scm.ss") "scm.ss")
(define (testable-file? pth)
(define suffix (filename-extension pth))
(and suffix
(ormap (lambda (bs) (bytes=? suffix bs))
(list #"ss" #"scm" #"scrbl" #"rkt" #"sls"))))
(define PROP:command-line "drdr:command-line") (define PROP:command-line "drdr:command-line")
(define PROP:timeout "drdr:timeout") (define PROP:timeout "drdr:timeout")
(define (path-command-line a-path) (define (path-command-line a-path)
(match (get-prop a-path 'drdr:command-line #f) (match (get-prop a-path 'drdr:command-line #f)
[#f [#f
(if (testable-file? a-path) (define suffix (filename-extension a-path))
(list "mzscheme" "-qt" (path->string* a-path)) (and suffix
#f)] (cond
[(ormap (lambda (bs) (bytes=? suffix bs))
(list #"ss" #"scm" #"scrbl" #"rkt" #"sls"))
(list "racket" "-qt" (path->string* a-path))]
[(ormap (lambda (bs) (bytes=? suffix bs))
(list #"rktl"))
(list "racket" "-f" (path->string* a-path))]
[else
#f]))]
["" [""
#f] #f]
[(? string? s) [(? string? s)

28
collects/meta/drdr/plt-build.ss
View File

@ -145,14 +145,16 @@
(revision-log-dir rev)) (revision-log-dir rev))
(define trunk->log (define trunk->log
(rebase-path trunk-dir log-dir)) (rebase-path trunk-dir log-dir))
(define mzscheme-path (define racket-path
(path->string (build-path trunk-dir "bin" "mzscheme"))) (path->string (build-path trunk-dir "bin" "racket")))
; XXX fix
(define mzc-path (define mzc-path
(path->string (build-path trunk-dir "bin" "mzc"))) (path->string (build-path trunk-dir "bin" "mzc")))
(define mred-text-path (define gracket-text-path
(path->string (build-path trunk-dir "bin" "mred-text"))) (path->string (build-path trunk-dir "bin" "gracket-text")))
(define mred-path (define gracket-path
(path->string (build-path trunk-dir "bin" "mred"))) (path->string (build-path trunk-dir "bin" "gracket")))
; XXX fix
(define planet-path (define planet-path
(path->string (build-path trunk-dir "bin" "planet"))) (path->string (build-path trunk-dir "bin" "planet")))
(define collects-pth (define collects-pth
@ -185,13 +187,19 @@
[#f [#f
#f] #f]
[(list-rest "mzscheme" rst) [(list-rest "mzscheme" rst)
(lambda () (list* mzscheme-path rst))] (lambda () (list* racket-path rst))]
[(list-rest "racket" rst)
(lambda () (list* racket-path rst))]
[(list-rest "mzc" rst) [(list-rest "mzc" rst)
(lambda () (list* mzc-path rst))] (lambda () (list* mzc-path rst))]
[(list-rest "mred-text" rst) [(list-rest "mred-text" rst)
(lambda () (list* mred-text-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))] (lambda () (list* gracket-text-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))]
[(list-rest "mred" rst) [(list-rest "mred" rst)
(lambda () (list* mred-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))] (lambda () (list* gracket-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))]
[(list-rest "gracket-text" rst)
(lambda () (list* gracket-text-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))]
[(list-rest "gracket" rst)
(lambda () (list* gracket-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))]
[_ [_
#f]))] #f]))]
(if pth-cmd (if pth-cmd
@ -233,7 +241,7 @@
#:timeout (current-subprocess-timeout-seconds) #:timeout (current-subprocess-timeout-seconds)
#:env (current-env) #:env (current-env)
(build-path log-dir "src" "build" "set-browser.ss") (build-path log-dir "src" "build" "set-browser.ss")
mzscheme-path racket-path
(list "-t" (path->string* (build-path (drdr-directory) "set-browser.ss")))) (list "-t" (path->string* (build-path (drdr-directory) "set-browser.ss"))))
; And go ; And go
(notify! "Starting testing") (notify! "Starting testing")