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

Incorporate new raco test usage

Browse Source
This commit is contained in:
Jay McCarthy 2013-12-31 10:13:42 -07:00
parent 0dd91cdc2f
commit 96e4ddd8ab
3 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/plt-services/meta/drdr/metadata.rkt
View File

@ -6,16 +6,13 @@
(define PROP:command-line "drdr:command-line")
(define PROP:timeout "drdr:timeout")
(define (path-command-line a-path)
(define (path-command-line a-path a-timeout)
(define suffix (filename-extension a-path))
(define default-cmd
(and suffix
(case (string->symbol (bytes->string/utf-8 suffix))
[(ss scm scrbl rkt sls)
'(raco "test" "-q" "-s" "main" "-s" "test" *)
'(racket *)
'(raco "test" *)]
[(rktl) '(racket "-f" *)]
`(raco "test" "-m" "--timeout" ,(number->string a-timeout) *)]
[else #f])))
(define (replace-* s)
(cond
@ -43,8 +40,11 @@
(provide/contract
[PROP:command-line string?]
[PROP:timeout string?]
[path-responsible (path-string? . -> . (or/c string? false/c))]
[path-command-line (path-string? . -> . (or/c (cons/c symbol? (listof string?)) false/c))]
[path-responsible
(path-string? . -> . (or/c string? false/c))]
[path-command-line
(-> path-string? exact-nonnegative-integer?
(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))])

2
pkgs/plt-services/meta/drdr/plt-build.rkt
View File

@ -216,7 +216,7 @@
(or (path-timeout pth)
(current-subprocess-timeout-seconds)))
(define pth-cmd/general
(path-command-line pth))
(path-command-line pth pth-timeout))
(define-values
(pth-cmd the-queue)
(match pth-cmd/general

4
pkgs/plt-services/meta/drdr/run-collect.rkt
View File

@ -68,7 +68,9 @@
(define output-done? (zero? open-ports))
(if (and output-done? process-done?)
(if status
(make-exit start-time end-time command-line (reverse log) status)
(if (= status 2)
(make-timeout start-time end-time command-line (reverse log))
(make-exit start-time end-time command-line (reverse log) status))
(make-timeout start-time end-time command-line (reverse log)))
(sync (if process-done?
never-evt