raco test: support ++arg <arg> and ++args <args>

Add a way for `raco test` to pass along arguments to the test program.

pkgs/compiler-lib/compiler/commands/test.rkt

@@ -9,6 +9,7 @@
          racket/place
          racket/future
          racket/file
+         racket/string
          compiler/find-exe
          raco/command-name
          racket/system
@@ -35,6 +36,7 @@
 (define empty-input? #f)
 (define heartbeat-secs #f)
 (define ignore-stderr-patterns null)
+(define extra-command-line-args null)
 
 (define jobs 0) ; 0 mean "default"
 (define task-sema (make-semaphore 1))
@@ -91,9 +93,9 @@
   (provide go)
   (define (go pch)
     (define l (place-channel-get pch))
+    (define args (cadddr (cdr l)))
     ;; Run the test:
-    (parameterize ([current-command-line-arguments (list->vector
-                                                    (cadddr (cdr l)))]
+    (parameterize ([current-command-line-arguments (list->vector args)]
                    [current-directory (cadddr l)])
       (when (cadr l) (dynamic-require (cadr l) (caddr l)))
       (dynamic-require (car l) (caddr l))
@@ -583,7 +585,7 @@
           ;; make sure "info.rkt" information is loaded:
           (check-info p))
         (define norm-p (normalize-info-path p))
-        (define args (get-cmdline norm-p))
+        (define args (append (get-cmdline norm-p) (reverse extra-command-line-args)))
         (define timeout (get-timeout norm-p))
         (define ignore-stderr (get-ignore-stderr norm-p))
         (define lock-name (get-lock-name norm-p))
@@ -1007,6 +1009,13 @@
   "Runs submodule <name>\n    (defaults to running just the `test' submodule)"
   (let ([n (string->symbol name)])
     (set! submodules (cons n submodules)))]
+ [("++arg") arg
+  "Adds <arg> to `current-command-line-arguments`"
+  (set! extra-command-line-args (cons arg extra-command-line-args))]
+  [("++args") args
+  "Adds <args> (whitespace-separated values) to `current-command-line-arguments`"
+  (set! extra-command-line-args
+        (append (reverse (string-split args)) extra-command-line-args))]
  #:once-any
  [("--run-if-absent" "-r")
   "Require module if submodule is absent (on by default)"

pkgs/compiler-test/tests/compiler/test/args.rkt

@@ -0,0 +1,12 @@
+#lang racket
+
+(module multi-test racket/base
+  (require racket/match)
+  (match (current-command-line-arguments)
+    [(vector "1" "2") 1]
+    [_ (void)]))
+
+(module+ test
+  (match (current-command-line-arguments)
+    [(vector "1") 1]
+    [_ (void)]))

pkgs/compiler-test/tests/compiler/test/runtime.rkt

@@ -4,12 +4,12 @@
 
 (define exe (find-exe))
 
-(define (try mode mod expect)
+(define (try mode mod expect . extra-args)
   (printf "trying ~s ~s\n" mod mode)
   (define s (open-output-bytes))
   (parameterize ([current-output-port s])
-    (system* exe "-l-" "raco" "test"
-             mode "-l" (string-append "tests/compiler/test/" mod)))
+    (apply system* exe "-l-" "raco" "test"
+           mode (append extra-args (list "-l" (string-append "tests/compiler/test/" mod)))))
   (define last-line
     (for/fold ([prev #f]) ([s (in-lines (open-input-bytes (get-output-bytes s)))])
       (if (or (eof-object? s)
@@ -17,12 +17,17 @@
           prev
           s)))
   (unless (equal? expect last-line)
-    (error 'runtime "test failed\n  module: ~s\n  expected: ~s\n  got: ~s"
-           mod expect last-line)))
+    (error 'runtime "test failed\n  module: ~s~a\n  expected: ~s\n  got: ~s"
+           mod
+           (if (null? extra-args) "" (format "\n  extra args: ~s" extra-args))
+           expect
+           last-line)))
 
 (for ([mod '("--direct" "--place" "--process")])
   (try mod "racket.rkt" "'(1 2)")
-  (try mod "scheme.rkt" "(1 2)"))
+  (try mod "scheme.rkt" "(1 2)")
+  (try mod "args.rkt" "1" "-q" "++arg" "1")
+  (try mod "args.rkt" "1" "-q" "-s" "multi-test" "++args" "1 2"))
 
 
 

pkgs/racket-doc/scribblings/raco/test.scrbl

@@ -163,6 +163,19 @@ The @exec{raco test} command accepts several flags:
        successes and failures, the table reports test and failure
        counts based on the log.}
 
+ @item{@DPFlag{arg} @nonterm{argument}
+       --- Forwards @nonterm{argument} to the invoked test module,
+       so that the invoked module sees @nonterm{argument} in its
+       @racket[current-command-line-arguments]. These arguments are
+       combined with any arguments specified in @filepath{info.rkt}
+       by @racket[test-command-line-arguments].}
+
+ @item{@DPFlag{args} @nonterm{arguments}
+        --- The same as @DPFlag{arg}, except that {arguments} is treated
+        as a whitespace-separated list of arguments to forward. To specify
+        multiple arguments using this flag, @nonterm{arguments} must be
+        enclosed in quotation marks.
+ }
 ]
 
 @history[#:changed "1.1" @elem{Added @DFlag{heartbeat}.}