From 8357a98e7c0c8690be7fe2903a310a3b93b2ab8f Mon Sep 17 00:00:00 2001 From: Tomas Volf <~@wolfsden.cz> Date: Sun, 14 Jul 2024 13:00:14 +0200 Subject: [PATCH 2/5] build: test-driver.scm: Output singleton metadata just once. 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. --- build-aux/test-driver.scm | 59 +++++++++++++++++++++------------------ 1 file changed, 32 insertions(+), 27 deletions(-) diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm index 471333b..71bca73 100755 --- a/build-aux/test-driver.scm +++ b/build-aux/test-driver.scm @@ -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 "2024-07-14.10") ;UTC +(define script-version "2024-07-14.11") ;UTC ;;; Copyright © 2015, 2016 Mathieu Lirzin ;;; Copyright © 2021 Maxim Cournoyer +;;; 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: @@ -105,15 +107,18 @@ case is shown.\n")) (out-port (current-output-port)) (trs-port (%make-void-port "w")) select exclude) - "Return an 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 an custom SRFI-64 test runner and a finalize procedure. 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 all your tests are finished, you need to call the finalize procedure to +do the final reporting." (define test-cases-start-time (make-hash-table)) @@ -171,8 +176,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)) @@ -189,15 +194,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))))) ;;; @@ -257,17 +261,18 @@ 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)))) -- 2.45.2