guix_mirror_bot pushed a commit to branch master
in repository guix.
commit 18ea608fcfec49a8a2f298714f745db9a9cbfc8b
Author: Tomas Volf <[email protected]>
AuthorDate: Mon Jul 15 22:53:02 2024 +0200
build: test-driver.scm: Utilize test-runner-group-path.
Test groups were not used in any meaningful way. The group path was not
printed and it was not used in test selection mechanism. I think groups are
useful, and it is nice to be able to, for example, run tests from a single
group.
This commit does two things. First, it changes the test reporting to
include
the value returned from test-runner-group-path, so you will know not only
the
test name, but the test group(s) as well. And second, it changes the test
selection (and exclusion) process to match against the "full" test name, so
group path + test name.
Hence
(test-begin "failing tests")
(test-equal "this should fail" 1 2)
(test-end)
will, depending on the output location, produce following text.
.trs:
:test-result: FAIL failing tests: this should fail [0.000s]
:test-global-result: FAIL
:recheck: yes
:copy-in-global-log: yes
.log:
test-name: failing tests: this should fail
location: test.scm:140
source:
+ (test-equal "this should fail" 1 2)
expected-value: 1
actual-value: 2
result: FAIL
stdout:
FAIL: test.scm - failing tests: this should fail [0.000s]
* build-aux/test-driver.scm (current-test-full-name): New procedure.
(test-runner-gnu): Use current-test-full-name instead of
test-runner-test-name.
(test-match-name*): Match against current-test-full-name. Use compose.
(test-match-name*/negated): Rewrite in terms of test-match-name*.
Change-Id: I3fb9a2a721165204f020b79e019533f799b790e4
Signed-off-by: Maxim Cournoyer <[email protected]>
Modified-by: Maxim Cournoyer <[email protected]>
---
build-aux/test-driver.scm | 20 ++++++++++++--------
1 file changed, 12 insertions(+), 8 deletions(-)
diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 6eb3a863f6..b74f8a23c7 100755
--- a/build-aux/test-driver.scm
+++ b/build-aux/test-driver.scm
@@ -106,6 +106,12 @@ case is shown.\n"))
(or (test-result-ref runner 'result-kind)
'skip))
+(define (current-test-full-name runner)
+ "Get full name (test group path + name) of current test."
+ (format #f "~{~a~^/~}: ~a"
+ (test-runner-group-path runner)
+ (test-runner-test-name runner)))
+
;;;
;;; SRFI 64 custom test runner.
@@ -134,7 +140,7 @@ called to do the final reporting."
(define (test-on-test-begin-gnu runner)
;; Procedure called at the start of an individual test case, before the
;; test expression (and expected value) are evaluated.
- (let ((test-case-name (test-runner-test-name runner))
+ (let ((test-case-name (current-test-full-name runner))
(start-time (current-time time-monotonic)))
(hash-set! test-cases-start-time test-case-name start-time)))
@@ -151,7 +157,7 @@ called to do the final reporting."
(let* ((results (test-result-alist runner))
(result? (cut assq <> results))
(result (cut assq-ref results <>))
- (test-case-name (test-runner-test-name runner))
+ (test-case-name (current-test-full-name runner))
(start (hash-ref test-cases-start-time test-case-name))
(end (current-time time-monotonic))
(time-elapsed (time-difference end start))
@@ -165,7 +171,7 @@ called to do the final reporting."
(and show-duration? time-elapsed-seconds)))
(unless (and errors-only? (not (test-failed? runner)))
- (format #t "test-name: ~A~%" (test-runner-test-name runner))
+ (format #t "test-name: ~A~%" test-case-name)
(format #t "location: ~A~%"
(string-append (result 'source-file) ":"
(number->string (result 'source-line))))
@@ -183,7 +189,7 @@ called to do the final reporting."
(format trs-port ":test-result: ~A ~A [~,3fs]~%"
(result->string (test-result-kind* runner))
- (test-runner-test-name runner) time-elapsed-seconds)))
+ test-case-name time-elapsed-seconds)))
(define (finalize runner)
"Procedure to call after all tests finish to do the final reporting."
@@ -229,13 +235,11 @@ called to do the final reporting."
;;;
(define (test-match-name* regexp)
"Return a test specifier that matches a test name against REGEXP."
- (lambda (runner)
- (string-match regexp (test-runner-test-name runner))))
+ (compose (cut string-match regexp <>) current-test-full-name))
(define (test-match-name*/negated regexp)
"Return a negated test specifier version of test-match-name*."
- (lambda (runner)
- (not (string-match regexp (test-runner-test-name runner)))))
+ (compose not (test-match-name* regexp)))
;;;
