From 7d728294481620e90f7b5e7a76e02e8032be578a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 26 Sep 2021 23:10:29 +0200 Subject: 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. --- gnu/build/marionette.scm | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) (limited to 'gnu') 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 -- cgit 1.4.1