bug#72130: test-driver.scm produces .trs file with undefined behavior

bug#72130: test-driver.scm produces .trs file with undefined behavior

[Tomas Volf]

[-- Attachment #1.1: Type: text/plain, Size: 1171 bytes --]

Hello,

currently there are two issues with build-aux/test-driver.scm.

1. :test-global-result: is mistyped as :global-test-result:.
2. Summarizing metadata are outputted on end of each test-group, meaning they
   will be present multiple times, if there is more than one test group.

First is somewhat fine, since, per the manual page, unknown keys are (for now)
ignored.  However second is explicitly stated to be undefined behavior, so it
should be fixed.

I am CC-ing both authors listed in the test-driver.scm, since I have no idea
where the upstream is (it seems to be just copied around between projects?).

You can find fixes for the first (0001) and second (0002) issues attached to
this email.

I am also including two additional patches (0003 refining :test-global-result:
for XPASS as XXX mentioned, 0005 improving support for test group since it was
somewhat lacking) which I consider useful and I have applied them to my local
copy of test-driver.scm file.  Feel free to apply them, or ignore them, as you
see fit.

Have a nice day,
Tomas Volf

--
There are only two hard things in Computer Science:
cache invalidation, naming things and off-by-one errors.

[-- Attachment #1.2: 0001-build-test-driver.scm-Fix-test-global-result-.trs-me.patch --]
[-- Type: text/plain, Size: 1604 bytes --]

From ff4a7a69e7f35ddf80287b230ac1b377e54b43e9 Mon Sep 17 00:00:00 2001
From: Tomas Volf <~@wolfsden.cz>
Date: Sun, 14 Jul 2024 01:08:49 +0200
Subject: [PATCH 1/5] build: test-driver.scm: Fix :test-global-result: .trs
 metadata.

According to the manual page, the correct metadata key is :test-global-result:
instead of the current :global-test-result:.

* build-aux/test-driver.scm (test-on-group-end-gnu): Fix :test-global-result:
metadata output.
---
 build-aux/test-driver.scm | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 9a0dcde..471333b 100755
--- a/build-aux/test-driver.scm
+++ b/build-aux/test-driver.scm
@@ -3,7 +3,7 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
 !#
 ;;;; test-driver.scm - Guile test driver for Automake testsuite harness
 
-(define script-version "2023-12-08.16") ;UTC
+(define script-version "2024-07-14.10") ;UTC
 
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -178,7 +178,7 @@ cases based on their names."
           (skip (or (positive? (test-runner-skip-count runner))
                     (positive? (test-runner-xfail-count runner)))))
       ;; XXX: The global results need some refinements for XPASS.
-      (format trs-port ":global-test-result: ~A~%"
+      (format trs-port ":test-global-result: ~A~%"
               (if fail "FAIL" (if skip "SKIP" "PASS")))
       (format trs-port ":recheck: ~A~%"
               (if fail "yes" "no"))
-- 
2.45.2


[-- Attachment #1.3: 0002-build-test-driver.scm-Output-singleton-metadata-just.patch --]
[-- Type: text/plain, Size: 6877 bytes --]

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 <mthl@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; 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)))))
 
 \f
 ;;;
@@ -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


[-- Attachment #1.4: 0003-build-test-driver.scm-Refine-the-global-test-result.patch --]
[-- Type: text/plain, Size: 3603 bytes --]

From 250cf5af8324bc09591f178c868f409574692de0 Mon Sep 17 00:00:00 2001
From: Tomas Volf <~@wolfsden.cz>
Date: Sun, 14 Jul 2024 22:45:16 +0200
Subject: [PATCH 3/5] build: test-driver.scm: Refine the global test result.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The :test-global-result: .trs metadata contained just either FAIL, SKIP or
PASS with a comment that further refinements are required for XPASS.  The
description of :test-global-result: is in the manual is as follows:

     This is used to declare the "global result" of the script.
     Currently, the value of this field is needed only to be reported
     (more or less verbatim) in the generated global log file
     ‘$(TEST_SUITE_LOG)’, so it’s quite free-form.  For example, a test
     script which runs 10 test cases, 6 of which pass and 4 of which are
     skipped, could reasonably have a ‘PASS/SKIP’ value for this field,
     while a test script which runs 19 successful tests and one failed
     test could have an ‘ALMOST PASSED’ value.

As we can see, the examples as `PASS/SKIP' and `ALMOST PASSED', so there is no
need to stick to strict model.  Hence this commit changes the resulting value
to be comma-separated list of PASS, FAIL, XPASS, XFAIL and SKIP.  The
respective elements are present only when the count of tests with such a
result is positive.

In practice, that should usually produce lines such as

    :test-global-result: PASS,FAIL

or

    :test-global-result: PASS

* build-aux/test-driver.scm (test-runner-gnu)[finalize]: Refine the output of
:test-global-result:.
---
 build-aux/test-driver.scm | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 71bca73..9d412e1 100755
--- a/build-aux/test-driver.scm
+++ b/build-aux/test-driver.scm
@@ -3,7 +3,7 @@ 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.11") ;UTC
+(define script-version "2024-07-14.20") ;UTC
 
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -182,9 +182,20 @@ do the final reporting."
                     (positive? (test-runner-xpass-count runner))))
           (skip (or (positive? (test-runner-skip-count runner))
                     (positive? (test-runner-xfail-count runner)))))
-      ;; XXX: The global results need some refinements for XPASS.
-      (format trs-port ":test-global-result: ~A~%"
-              (if fail "FAIL" (if skip "SKIP" "PASS")))
+      (format trs-port ":test-global-result: ~{~A~^,~}~%"
+              (filter-map (λ (proc str)
+                            (let ((n (proc runner)))
+                              (if (positive? n) str #f)))
+                          (list test-runner-pass-count
+                                test-runner-fail-count
+                                test-runner-xpass-count
+                                test-runner-xfail-count
+                                test-runner-skip-count)
+                          (list "PASS"
+                                "FAIL"
+                                "XPASS"
+                                "XFAIL"
+                                "SKIP")))
       (format trs-port ":recheck: ~A~%"
               (if fail "yes" "no"))
       (format trs-port ":copy-in-global-log: ~A~%"
-- 
2.45.2


[-- Attachment #1.5: 0005-build-test-driver.scm-Utilize-test-runner-group-path.patch --]
[-- Type: text/plain, Size: 5386 bytes --]

From a3277fbf435ca6d3f732ca690513b975e0d66f08 Mon Sep 17 00:00:00 2001
From: Tomas Volf <~@wolfsden.cz>
Date: Mon, 15 Jul 2024 22:53:02 +0200
Subject: [PATCH 5/5] 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.
(test-match-name*/negated): Rewrite in terms of test-match-name*.
---
 build-aux/test-driver.scm | 22 ++++++++++++++--------
 1 file changed, 14 insertions(+), 8 deletions(-)

diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 9d412e1..8d39046 100755
--- a/build-aux/test-driver.scm
+++ b/build-aux/test-driver.scm
@@ -3,7 +3,7 @@ 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.20") ;UTC
+(define script-version "2024-07-15.15") ;UTC
 
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -102,6 +102,12 @@ case is shown.\n"))
 ;;; SRFI 64 custom test runner.
 ;;;
 
+(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)))
+
 (define* (test-runner-gnu test-name #:key color? brief? errors-only?
                           show-duration?
                           (out-port (current-output-port))
@@ -125,7 +131,7 @@ 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)))
 
@@ -142,7 +148,7 @@ 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))
@@ -156,7 +162,7 @@ do the final reporting."
                 (and show-duration? time-elapsed-seconds)))
 
       (unless (and errors-only? (not (test-failed? runner)))
-        (format #t "test-name: ~A~%" (result 'test-name))
+        (format #t "test-name: ~A~%" test-case-name)
         (format #t "location: ~A~%"
                 (string-append (result 'source-file) ":"
                                (number->string (result 'source-line))))
@@ -174,7 +180,7 @@ 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."
@@ -221,12 +227,12 @@ 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))))
+    (string-match regexp (current-test-full-name runner))))
 
 (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)))
 
 ;;; XXX: test-match-all is a syntax, which isn't convenient to use with a list
 ;;; of test specifiers computed at run time.  Copy this SRFI 64 internal
-- 
2.45.2


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]