From 62f444d4e13f3a59f59d22f7fee70de63140e7b7 Mon Sep 17 00:00:00 2001 From: "Walter H. Yang" Date: Tue, 27 Oct 2020 13:09:22 +0800 Subject: [PATCH] raco: test: Add support to output to file (#3451) Example: raco test --output output.txt utils.rkt Fixes #3161 Signed-off-by: Hong Yang --- pkgs/compiler-lib/compiler/commands/test.rkt | 23 +++++++++- .../tests/compiler/test/output.rkt | 7 +++ .../tests/compiler/test/runtime.rkt | 44 ++++++++++++++----- pkgs/racket-doc/scribblings/raco/test.scrbl | 9 +++- 4 files changed, 68 insertions(+), 15 deletions(-) create mode 100644 pkgs/compiler-test/tests/compiler/test/output.rkt diff --git a/pkgs/compiler-lib/compiler/commands/test.rkt b/pkgs/compiler-lib/compiler/commands/test.rkt index 220e4992c4..c88b0b5cab 100644 --- a/pkgs/compiler-lib/compiler/commands/test.rkt +++ b/pkgs/compiler-lib/compiler/commands/test.rkt @@ -43,6 +43,7 @@ (define default-timeout #f) ; #f means "none" (define default-mode #f) ; #f => depends on how many files are provided +(define default-output-file #f) ; #f means no --output option specified (define single-file? #t) @@ -1092,8 +1093,12 @@ [("--table" "-t") "Print a summary table" (set! table? #t)] + #:once-each + [("--output" "-o") file + "Save stdout and stderr to file, overwrite if it exists." + (set! default-output-file file)] #:args file-or-directory-or-collects-or-pkgs - (let () + (define (test) (define file-or-directory (maybe-expand-package-deps file-or-directory-or-collects-or-pkgs)) (unless (= 1 (length file-or-directory)) @@ -1129,4 +1134,18 @@ (exit (cond [(positive? (summary-timeout sum1)) 2] [(positive? (summary-failed sum1)) 1] - [else 0])))) + [else 0]))) + + ;; Save the stdout/stderr into a file. + (define (test-with-output-file file-name) + (call-with-output-file* + (string->path file-name) + (lambda (out) + (parameterize ([current-output-port out] + [current-error-port out]) + (test))) + #:exists 'truncate)) + + (if (string? default-output-file) + (test-with-output-file default-output-file) + (test))) diff --git a/pkgs/compiler-test/tests/compiler/test/output.rkt b/pkgs/compiler-test/tests/compiler/test/output.rkt new file mode 100644 index 0000000000..130b55658f --- /dev/null +++ b/pkgs/compiler-test/tests/compiler/test/output.rkt @@ -0,0 +1,7 @@ +#lang racket + +(module test-stdout racket/base + (printf "1\n")) + +(module test-stderr racket/base + (eprintf "1\n")) diff --git a/pkgs/compiler-test/tests/compiler/test/runtime.rkt b/pkgs/compiler-test/tests/compiler/test/runtime.rkt index 93c0b8f9e1..be8d7fd43f 100644 --- a/pkgs/compiler-test/tests/compiler/test/runtime.rkt +++ b/pkgs/compiler-test/tests/compiler/test/runtime.rkt @@ -1,34 +1,56 @@ #lang racket/base (require racket/system + racket/file compiler/find-exe) (define exe (find-exe)) +;; Return last line of the input, or #f if it's empty. +(define (read-last-line input) + (for/fold ([prev #f]) ([s (in-lines input)]) + (if (or (eof-object? s) + (equal? s "1 test passed")) + prev + s))) + +;; 'expect' is either a string or a procedure to check the result (define (try mode mod expect . extra-args) (printf "trying ~s ~s\n" mod mode) (define s (open-output-bytes)) (parameterize ([current-output-port s]) (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) - (equal? s "1 test passed")) - prev - s))) - (unless (equal? expect last-line) + (define last-line (read-last-line (open-input-bytes (get-output-bytes s)))) + (unless (if (procedure? expect) + (expect) + (equal? 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))) +(define (check-output-file expect file) + (call-with-input-file* file + (lambda (in) + (let* ([last-line (read-last-line in)] + [result (equal? expect last-line)]) + (unless result + (eprintf "Output file check, expected: ~s, got: ~s\n" expect last-line)) + result)))) + (for ([mod '("--direct" "--place" "--process")]) (try mod "racket.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")) - - - + (try mod "args.rkt" "1" "-q" "-s" "multi-test" "++args" "1 2") + ;; Test for 'raco test --output ' + ;; We check the content of the instead of the standard output + (let ([file (make-temporary-file)]) + (for ([sub-module '("test-stdout" "test-stderr")]) + (try mod "output.rkt" + (lambda () (check-output-file "1" file)) + "-s" sub-module + "--output" (path->string file))) + (delete-file file))) diff --git a/pkgs/racket-doc/scribblings/raco/test.scrbl b/pkgs/racket-doc/scribblings/raco/test.scrbl index 862b436164..8a0f5b4c19 100644 --- a/pkgs/racket-doc/scribblings/raco/test.scrbl +++ b/pkgs/racket-doc/scribblings/raco/test.scrbl @@ -179,7 +179,11 @@ The @exec{raco test} command accepts several flags: as a whitespace-delimited list of arguments to add. To specify multiple arguments using this flag within a typical shell, @nonterm{arguments} must be - enclosed in quotation marks. + enclosed in quotation marks.} + + @item{@DFlag{output} or @Flag{o} @nonterm{file} + --- Save all stdout and stderr output into @nonterm{file}. + The target @nonterm{file} will be overwritten if it exists already. } ] @@ -187,7 +191,8 @@ The @exec{raco test} command accepts several flags: #:changed "1.4" @elem{Changed recognition of module suffixes to use @racket[get-module-suffixes], which implies recognizing @filepath{.ss} and @filepath{.rkt}.} #:changed "1.5" @elem{Added @DPFlag{ignore-stderr}.} - #:changed "1.6" @elem{Added @DPFlag{arg} and @DPFlag{args}.}] + #:changed "1.6" @elem{Added @DPFlag{arg} and @DPFlag{args}.} + #:changed "1.8" @elem{Added @DFlag{output} and @Flag{o}.}] @section[#:tag "test-config"]{Test Configuration by Submodule}