raco: test: Add support to output to file (#3451)

Example:
 raco test --output output.txt utils.rkt

Fixes #3161
Signed-off-by: Hong Yang <yangh.cn@gmail.com>

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)))

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"))

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
+  (define last-line (read-last-line (open-input-bytes (get-output-bytes s))))
-    (for/fold ([prev #f]) ([s (in-lines (open-input-bytes (get-output-bytes s)))])
+  (unless (if (procedure? expect)
-      (if (or (eof-object? s)
+              (expect)
-              (equal? s "1 test passed"))
+              (equal? expect last-line))
-          prev
-          s)))
-  (unless (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 <file>'
+  ;; We check the content of the <file> 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)))

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}