ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* gnu/build/marionette.scm (system-test-runner): Take optional
'log-directory' parameter.  Add 'test-begin' handler and honor
LOG-DIRECTORY.
This commit is contained in:
Ludovic Courtès 2021-09-26 23:10:29 +02:00
parent 9b9bfc7ac2
commit 7d72829448
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 18 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
gnu/build/marionette.scm
View file

@ -366,9 +366,25 @@ (define* (marionette-type str marionette
;;; 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