marionette: 'system-test-runner' can create output directory.

* gnu/build/marionette.scm (system-test-runner): Take optional
'log-directory' parameter.  Add 'test-begin' handler and honor
LOG-DIRECTORY.

1 files changed, 18 insertions, 2 deletions

diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 08de7940e3..e76ef16f51 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -366,9 +366,25 @@ to actual keystrokes."
 ;;; Test helper.
 ;;;
 
-(define (system-test-runner)
-  "Return a SRFI-64 test runner that calls 'exit' upon 'test-end'."
+(define* (system-test-runner #:optional log-directory)
+  "Return a SRFI-64 test runner that calls 'exit' upon 'test-end'.  When
+LOG-DIRECTORY is specified, create log file within it."
   (let ((runner  (test-runner-simple)))
+    ;; Log to a file under LOG-DIRECTORY.
+    (test-runner-on-group-begin! runner
+      (let ((on-begin (test-runner-on-group-begin runner)))
+        (lambda (runner suite-name count)
+          (when log-directory
+            (catch 'system-error
+              (lambda ()
+                (mkdir log-directory))
+              (lambda args
+                (unless (= (system-error-errno args) EEXIST)
+                  (apply throw args))))
+            (set! test-log-to-file
+                  (string-append log-directory "/" suite-name ".log")))
+          (on-begin runner suite-name count))))
+
     ;; On 'test-end', display test results and exit with zero if and only if
     ;; there were no test failures.
     (test-runner-on-final! runner