tribes/guix
1
0
Fork 1
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-29 05:30:32 +02:00
Code Activity

build: test-driver.scm: Output singleton metadata just once.

Browse Source 
Current implementation printed metadata supposed to be present just once per
.trs file on the end of each test group.  According to the automake's manual
that is undefined behavior.  This commit fixes it by printing that metadata
just once, after all tests did run.

Since there is no built-in hook that could be used for
that (test-runner-on-final runs on *each* outermost test-end), I introduced
new `finalize' procedure that need to be called by the user.  Possibly not the
most elegant solution, but since we are the only user, it works fine and
produces actually valid .trs file.

That also means there is no longer any use for test-runner-on-test-end!.

* build-aux/test-driver.scm (test-runner-gnu): Define new procedure `finalize'
and return it together with the runner.  Do not call
test-runner-on-group-end!.
(main): Call the `finalize' after all tests are done.

Signed-off-by: Maxim Cournoyer <maxim@guixotic.coop>
This commit is contained in:
Tomas Volf
2024-07-14 13:00:14 +02:00
committed by Maxim Cournoyer
parent 5fada9a751
commit b93c51c4d7
1 changed files with 33 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

60
build-aux/test-driver.scm
View File

@@ -3,10 +3,11 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
!#
;;;; test-driver.scm - Guile test driver for Automake testsuite harness
(define script-version "2026-03-19.13") ;UTC
(define script-version "2026-03-19.14") ;UTC
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2021 Maxim Cournoyer <maxim@guixotic.coop>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
;;;
;;; This program is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
@@ -35,7 +36,8 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
(srfi srfi-1)
(srfi srfi-19)
(srfi srfi-26)
(srfi srfi-64))
(srfi srfi-64)
(srfi srfi-71))
(define (show-help)
(display "Usage:
@@ -114,15 +116,18 @@ case is shown.\n"))
(out-port (current-output-port))
(trs-port (%make-void-port "w"))
select exclude)
"Return a custom SRFI-64 test runner. TEST-NAME is a string specifying the
file name of the current the test. COLOR? specifies whether to use colors.
When BRIEF? is true, the individual test cases results are masked and only the
summary is shown. ERRORS-ONLY? reduces the amount of test case metadata
logged to only that of the failed test cases. OUT-PORT and TRS-PORT must be
output ports. OUT-PORT defaults to the current output port, while TRS-PORT
defaults to a void port, which means no TRS output is logged. SELECT and
EXCLUDE may take a regular expression to select or exclude individual test
cases based on their names."
"Return a custom SRFI-64 test runner and a `finalize' procedure as multiple
values. TEST-NAME is a string specifying the file name of the current the
test. COLOR? specifies whether to use colors. When BRIEF? is true, the
individual test cases results are masked and only the summary is shown.
ERRORS-ONLY? reduces the amount of test case metadata logged to only that of
the failed test cases. OUT-PORT and TRS-PORT must be output ports. OUT-PORT
defaults to the current output port, while TRS-PORT defaults to a void port,
which means no TRS output is logged. SELECT and EXCLUDE may take a regular
expression to select or exclude individual test cases based on their names.
After the tests are finished running, the `finalize' procedure should be
called to do the final reporting."
(define test-cases-start-time (make-hash-table))
@@ -180,8 +185,8 @@ cases based on their names."
(result->string (test-result-kind* runner))
(test-runner-test-name runner) time-elapsed-seconds)))
(define (test-on-group-end-gnu runner)
;; Procedure called by a 'test-end', including at the end of a test-group.
(define (finalize runner)
"Procedure to call after all tests finish to do the final reporting."
(let ((fail (or (positive? (test-runner-fail-count runner))
(positive? (test-runner-xpass-count runner))))
(skip (or (positive? (test-runner-skip-count runner))
@@ -198,15 +203,14 @@ cases based on their names."
(format out-port "~A: ~A~%"
(result->string (if fail 'fail (if skip 'skip 'pass))
#:colorize? color?)
test-name))
#f))
test-name))))
(let ((runner (test-runner-null)))
(test-runner-on-test-begin! runner test-on-test-begin-gnu)
(test-runner-on-test-end! runner test-on-test-end-gnu)
(test-runner-on-group-end! runner test-on-group-end-gnu)
(test-runner-on-bad-end-name! runner test-on-bad-end-name-simple)
runner))
(values runner
(λ () (finalize runner)))))
;;;
@@ -252,17 +256,19 @@ cases based on their names."
(redirect-port log (current-output-port))
(redirect-port log (current-warning-port))
(redirect-port log (current-error-port)))
(test-with-runner
(test-runner-gnu test-name
#:color? color-tests
#:brief? (option->boolean opts 'brief)
#:errors-only? (option->boolean opts 'errors-only)
#:show-duration? (option->boolean
opts 'show-duration)
#:out-port out #:trs-port trs)
(test-apply test-specifier
(let ((runner
finalize (test-runner-gnu
test-name
#:color? color-tests
#:brief? (option->boolean opts 'brief)
#:errors-only? (option->boolean opts 'errors-only)
#:show-duration? (option->boolean
opts 'show-duration)
#:out-port out #:trs-port trs)))
(test-apply runner test-specifier
(lambda _
(load-from-path test-name))))
(load-from-path test-name)))
(finalize))
(and=> log close-port)
(and=> trs close-port)
(close-port out))))