diff --git a/pkgs/compiler-lib/compiler/commands/test.rkt b/pkgs/compiler-lib/compiler/commands/test.rkt index ddb0755d79..98e174c1e2 100644 --- a/pkgs/compiler-lib/compiler/commands/test.rkt +++ b/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 \n (defaults to running just the `test' submodule)" (let ([n (string->symbol name)]) (set! submodules (cons n submodules)))] + [("++arg") arg + "Adds to `current-command-line-arguments`" + (set! extra-command-line-args (cons arg extra-command-line-args))] + [("++args") args + "Adds (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)" diff --git a/pkgs/compiler-test/tests/compiler/test/args.rkt b/pkgs/compiler-test/tests/compiler/test/args.rkt new file mode 100644 index 0000000000..fe8f71f1a9 --- /dev/null +++ b/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)])) diff --git a/pkgs/compiler-test/tests/compiler/test/runtime.rkt b/pkgs/compiler-test/tests/compiler/test/runtime.rkt index 5ecc70bb90..93c0b8f9e1 100644 --- a/pkgs/compiler-test/tests/compiler/test/runtime.rkt +++ b/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")) diff --git a/pkgs/racket-doc/scribblings/raco/test.scrbl b/pkgs/racket-doc/scribblings/raco/test.scrbl index d87431895c..7da8609cb2 100644 --- a/pkgs/racket-doc/scribblings/raco/test.scrbl +++ b/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}.}