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"
"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:timeout "drdr:timeout")
(define (path-command-line a-path)
(match (get-prop a-path 'drdr:command-line #f)
[#f
(if (testable-file? a-path)
(list "mzscheme" "-qt" (path->string* a-path))
#f)]
(define suffix (filename-extension a-path))
(and suffix
(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]
[(? string? s)

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

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