diff --git a/collects/compiler/commands/test.rkt b/collects/compiler/commands/test.rkt index 082b028536..6d6abb2b55 100644 --- a/collects/compiler/commands/test.rkt +++ b/collects/compiler/commands/test.rkt @@ -6,6 +6,7 @@ (define submodule 'test) (define run-anyways? #t) +(define collections? #f) (define (do-test e [check-suffix? #f]) (match e @@ -13,22 +14,46 @@ (do-test (string->path s))] [(? path? p) (cond - [(directory-exists? p) - (for-each - (λ (dp) + [(directory-exists? p) + (for-each + (λ (dp) (do-test (build-path p dp) #t)) - (directory-list p))] - [(and (file-exists? p) - (or (not check-suffix?) - (regexp-match #rx#"\\.rkt$" (path->bytes p)))) - (define mod `(submod ,p ,submodule)) - (cond - [(module-declared? mod #t) - (dynamic-require mod #f)] - [(and run-anyways? (module-declared? p #t)) - (dynamic-require p #f)])] - [(not (file-exists? p)) - (error 'test "Given path ~e does not exist" p)])])) + (directory-list p))] + [(and (file-exists? p) + (or (not check-suffix?) + (regexp-match #rx#"\\.rkt$" (path->bytes p)))) + (printf "testing ~a\n" p) + (define mod `(submod ,p ,submodule)) + (cond + [(module-declared? mod #t) + (dynamic-require mod #f)] + [(and run-anyways? (module-declared? p #t)) + (dynamic-require p #f)])] + [(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 #:program (short-program+command-name) @@ -42,5 +67,8 @@ [("--no-run-if-absent" "-x") "Require nothing if submodule is absent" (set! run-anyways? #f)] + [("--collection" "-c") + "Interpret arguments as collections" + (set! collections? #t)] #:args file-or-directory - (for-each do-test file-or-directory)) + (for-each do-test-wrap file-or-directory)) diff --git a/collects/scribblings/raco/test.scrbl b/collects/scribblings/raco/test.scrbl index 99e0a94cf6..2484ffc74f 100644 --- a/collects/scribblings/raco/test.scrbl +++ b/collects/scribblings/raco/test.scrbl @@ -25,4 +25,7 @@ The @exec{raco test} command accepts a few flags: @item{@Flag{x} or @DFlag{no-run-if-absent} --- 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.} ]