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 <maxim@guixotic.coop>
Modified-by: Maxim Cournoyer <maxim@guixotic.coop>

1 files changed, 12 insertions, 8 deletions

diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 6eb3a863f6a..b74f8a23c71 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)))
 
 
 ;;;