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

Extending raco test to work on collections

Browse Source
This commit is contained in:
Jay McCarthy 2013-01-09 07:59:47 -07:00
parent 7cddc64e5a
commit 3e0fff7dff
2 changed files with 47 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/compiler/commands/test.rkt
View File

@ -6,6 +6,7 @@
(define submodule 'test) (define submodule 'test)
(define run-anyways? #t) (define run-anyways? #t)
(define collections? #f)
(define (do-test e [check-suffix? #f]) (define (do-test e [check-suffix? #f])
(match e (match e
@ -13,22 +14,46 @@
(do-test (string->path s))] (do-test (string->path s))]
[(? path? p) [(? path? p)
(cond (cond
[(directory-exists? p) [(directory-exists? p)
(for-each (for-each
(λ (dp) (λ (dp)
(do-test (build-path p dp) #t)) (do-test (build-path p dp) #t))
(directory-list p))] (directory-list p))]
[(and (file-exists? p) [(and (file-exists? p)
(or (not check-suffix?) (or (not check-suffix?)
(regexp-match #rx#"\\.rkt$" (path->bytes p)))) (regexp-match #rx#"\\.rkt$" (path->bytes p))))
(define mod `(submod ,p ,submodule)) (printf "testing ~a\n" p)
(cond (define mod `(submod ,p ,submodule))
[(module-declared? mod #t) (cond
(dynamic-require mod #f)] [(module-declared? mod #t)
[(and run-anyways? (module-declared? p #t)) (dynamic-require mod #f)]
(dynamic-require p #f)])] [(and run-anyways? (module-declared? p #t))
[(not (file-exists? p)) (dynamic-require p #f)])]
(error 'test "Given path ~e does not exist" p)])])) [(not (file-exists? p))
(error 'test "Given path ~e does not exist" p)])]))
;; XXX This should be in Racket somewhere and return all the paths,
;; including the ones from the user and system collection links files (the system one is not specified in the docs, so I can't actually implement it correctly)
(define (all-library-collection-paths)
(find-library-collection-paths))
;; XXX This should be in Racket somewhere and return all the
;; collection paths, rather than just the first as collection-path
;; does.
;;
;; This implementation is wrong, btw, because it would ignore
;; collect-only links
(define (collection-paths c)
(for/list ([r (all-library-collection-paths)]
#:when (directory-exists? (build-path r c)))
(build-path r c)))
(define (do-test-wrap e)
(cond
[collections?
(for-each do-test (collection-paths e))]
[else
(do-test e)]))
(command-line (command-line
#:program (short-program+command-name) #:program (short-program+command-name)
@ -42,5 +67,8 @@
[("--no-run-if-absent" "-x") [("--no-run-if-absent" "-x")
"Require nothing if submodule is absent" "Require nothing if submodule is absent"
(set! run-anyways? #f)] (set! run-anyways? #f)]
[("--collection" "-c")
"Interpret arguments as collections"
(set! collections? #t)]
#:args file-or-directory #:args file-or-directory
(for-each do-test file-or-directory)) (for-each do-test-wrap file-or-directory))

3
collects/scribblings/raco/test.scrbl
View File

@ -25,4 +25,7 @@ The @exec{raco test} command accepts a few flags:
@item{@Flag{x} or @DFlag{no-run-if-absent} @item{@Flag{x} or @DFlag{no-run-if-absent}
--- Ignores a file if the relevant submodule is not present.} --- Ignores a file if the relevant submodule is not present.}
@item{@Flag{c} or @DFlag{collection}
--- Intreprets the arguments as collections where all files should be tested.}
] ]