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

Updating to use new props format

Browse Source
This commit is contained in:
Jay McCarthy 2010-05-14 11:04:58 -06:00
parent 05c8289925
commit 1d0bc61098
2 changed files with 27 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,25 +7,26 @@
(define PROP:timeout "drdr:timeout")
(define (path-command-line a-path)
(match (get-prop a-path 'drdr:command-line #f)
[#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)
(map (lambda (s)
(regexp-replace (regexp-quote "~s") s (path->string* a-path)))
(regexp-split #rx" " s))]))
(define suffix (filename-extension a-path))
(define default-cmd
(and suffix
(cond
[(ormap (lambda (bs) (bytes=? suffix bs))
(list #"ss" #"scm" #"scrbl" #"rkt" #"sls"))
'(racket "-qt" *)]
[(ormap (lambda (bs) (bytes=? suffix bs))
(list #"rktl"))
'(racket "-f" *)]
[else
#f])))
(define (replace-* s)
(if (eq? '* s)
(path->string* a-path)
s))
(match (get-prop a-path 'drdr:command-line default-cmd)
[#f #f]
[(? list? l)
(map replace-* l)]))
(define (path-timeout a-path)
(get-prop a-path 'drdr:timeout #f))
@ -42,7 +43,7 @@
[PROP:command-line string?]
[PROP:timeout string?]
[path-responsible (path-string? . -> . (or/c string? false/c))]
[path-command-line (path-string? . -> . (or/c (listof string?) false/c))]
[path-command-line (path-string? . -> . (or/c (cons/c symbol? (listof string?)) false/c))]
[path-random? (path-string? . -> . boolean?)]
[path-timeout (path-string? . -> . (or/c exact-nonnegative-integer? false/c))])

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

@ -186,22 +186,16 @@
(match pth-cmd/general
[#f
#f]
[(list-rest "mzscheme" rst)
[(list-rest (or 'mzscheme 'racket) 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))]
[(list-rest "mred-text" rst)
[(list-rest (or 'mred 'mred-text
'gracket 'gracket-text)
rst)
(lambda () (list* gracket-text-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))]
[(list-rest "mred" 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
(submit-job!
test-workers