Extending raco test to work on collections

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
@@ -21,6 +22,7 @@
        [(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)
@@ -30,6 +32,29 @@
        [(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)
  #:once-each
@@ -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))

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.}
 ]