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

Adding --deps

Browse Source
This commit is contained in:
Jay McCarthy 2017-10-20 11:32:04 -04:00
parent 62b17db270
commit 5662ed8e99
1 changed files with 56 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
pkgs/compiler-lib/compiler/commands/test.rkt
View File

@ -972,6 +972,21 @@
s)) s))
n) n)
(define check-pkg-deps? #f)
(define (maybe-expand-package-deps l)
(cond
[(and packages? check-pkg-deps?)
(hash-keys
(for/fold ([h (hash)]) ([p (in-list l)])
(define-values (sum _ deps)
(get-pkg-content (pkg-desc p 'name p #f #f)
#:extract-info extract-pkg-dependencies
#:use-cache? #t))
(for/fold ([h h]) ([d (in-list (cons p deps))])
(hash-set h d #t))))]
[else
l]))
(command-line (command-line
#:program (short-program+command-name) #:program (short-program+command-name)
#:once-any #:once-any
@ -1059,6 +1074,9 @@
[("--check-stderr" "-e") [("--check-stderr" "-e")
"Treat stderr output as a test failure" "Treat stderr output as a test failure"
(set! check-stderr? #t)] (set! check-stderr? #t)]
[("--deps")
"If treating arguments as packages, also test dependencies"
(set! check-pkg-deps? #t)]
#:multi #:multi
[("++ignore-stderr") pattern [("++ignore-stderr") pattern
"Ignore stderr output that matches #px\"<pattern>\"" "Ignore stderr output that matches #px\"<pattern>\""
@ -1074,38 +1092,41 @@
[("--table" "-t") [("--table" "-t")
"Print a summary table" "Print a summary table"
(set! table? #t)] (set! table? #t)]
#:args file-or-directory #:args file-or-directory-or-collects-or-pkgs
(begin (unless (= 1 (length file-or-directory)) (let ()
(set! single-file? #f)) (define file-or-directory
(when (and (eq? configure-runtime 'default) (maybe-expand-package-deps file-or-directory-or-collects-or-pkgs))
(or (and (not single-file?) (unless (= 1 (length file-or-directory))
(not (memq default-mode '(process place)))) (set! single-file? #f))
(not (null? submodules)))) (when (and (eq? configure-runtime 'default)
(set! configure-runtime #f)) (or (and (not single-file?)
(define sum (not (memq default-mode '(process place))))
;; The #:sema argument everywhre makes tests start (not (null? submodules))))
;; in a deterministic order: (set! configure-runtime #f))
(map/parallel (lambda (f #:sema s) (define sum
(test-top f ;; The #:sema argument everywhre makes tests start
#:check-suffix? check-top-suffix? ;; in a deterministic order:
#:sema s)) (map/parallel (lambda (f #:sema s)
file-or-directory (test-top f
#:sema (make-semaphore))) #:check-suffix? check-top-suffix?
(when table? #:sema s))
(display-summary sum)) file-or-directory
(unless (or (eq? default-mode 'direct) #:sema (make-semaphore)))
(and (not default-mode) single-file?)) (when table?
;; Re-log failures and successes, and then report using `test-log`. (display-summary sum))
;; (This is awkward; is it better to not try to use `test-log`?) (unless (or (eq? default-mode 'direct)
(for ([s (in-list sum)]) (and (not default-mode) single-file?))
(for ([i (in-range (summary-failed s))]) ;; Re-log failures and successes, and then report using `test-log`.
(test-log! #f)) ;; (This is awkward; is it better to not try to use `test-log`?)
(for ([i (in-range (- (summary-total s) (for ([s (in-list sum)])
(summary-failed s)))]) (for ([i (in-range (summary-failed s))])
(test-log! #t)))) (test-log! #f))
(test-log #:display? #t #:exit? #f) (for ([i (in-range (- (summary-total s)
(define sum1 (call-with-summary #f (lambda () sum))) (summary-failed s)))])
(exit (cond (test-log! #t))))
[(positive? (summary-timeout sum1)) 2] (test-log #:display? #t #:exit? #f)
[(positive? (summary-failed sum1)) 1] (define sum1 (call-with-summary #f (lambda () sum)))
[else 0])))) (exit (cond
[(positive? (summary-timeout sum1)) 2]
[(positive? (summary-failed sum1)) 1]
[else 0]))))