test - Supporting packages in raco test

collects/compiler/commands/test.rkt

@@ -2,11 +2,11 @@
 (require racket/cmdline
          racket/match
          racket/path
-         raco/command-name)
+         raco/command-name
+         planet2/lib)
 
 (define submodule 'test)
 (define run-anyways? #t)
-(define collections? #f)
 
 (define (do-test e [check-suffix? #f])
   (match e
@@ -48,10 +48,28 @@
              #:when (directory-exists? (build-path r c)))
     (build-path r c)))
 
+(define collections? #f)
+(define packages? #f)
+
 (define (do-test-wrap e)
   (cond
     [collections?
-     (for-each do-test (collection-paths e))]
+     (match (collection-paths e)
+       [(list)
+        (error 'test "Collection ~e is not installed" e)]
+       [l
+        (for-each do-test l)])]
+    [packages?
+     (unless
+         (for*/or ([civs (in-list '(#t #f))]
+                   [cisw (in-list '(#f #t))])
+           (define pd
+             (parameterize ([current-install-version-specific? civs]
+                            [current-install-system-wide? cisw])
+               (with-handlers ([exn:fail? (λ (x) #f)])
+                 (package-directory e))))
+           (and pd (do-test pd)))
+       (error 'test "Package ~e is not installed" e))]
     [else
      (do-test e)]))
 
@@ -67,8 +85,12 @@
  [("--no-run-if-absent" "-x")
   "Require nothing if submodule is absent"
   (set! run-anyways? #f)]
+ #:once-any
  [("--collection" "-c")
   "Interpret arguments as collections"
   (set! collections? #t)]
+ [("--package" "-p")
+  "Interpret arguments as packages"
+  (set! packages? #t)]
  #:args file-or-directory
  (for-each do-test-wrap file-or-directory))

collects/planet2/lib.rkt

@@ -305,8 +305,6 @@
   (struct-copy install-info if
                [checksum op]))
 
-
-
 (define (package-directory pkg-name)
   (match-define (pkg-info orig-pkg checksum _)
                 (package-info pkg-name))
@@ -1165,6 +1163,8 @@
    (parameter/c string?)]
   [current-pkg-error 
    (parameter/c procedure?)]
+  [package-directory
+   (-> string? path-string?)]
   [pkg-desc 
    (-> string? 
        (or/c #f 'file 'dir 'link 'file-url 'dir-url 'github 'name) 

collects/scribblings/raco/pkg.scrbl

@@ -1,8 +1,8 @@
 #lang scribble/doc
 @(require scribble/manual "common.rkt")
 
-@title[#:tag "pkg"]{@exec{raco pkg}: Planet 2 Package Management}
+@title[#:tag "pkg"]{@exec{raco pkg}: Package Management}
 
 See @other-manual['(lib "planet2/scribblings/planet2.scrbl")] for
 information on the @exec{raco pkg} command, which is used for
-managing external code packages with Planet 2.
+managing external code packages.

collects/scribblings/raco/test.scrbl

@@ -28,4 +28,7 @@ The @exec{raco test} command accepts a few flags:
 
  @item{@Flag{c} or @DFlag{collection}
        --- Intreprets the arguments as collections where all files should be tested.}
+
+ @item{@Flag{p} or @DFlag{package}
+       --- Intreprets the arguments as packages where all files should be tested. (All package scopes are searched for the first, most specific package.)}
 ]