bug#74030: [PATCH] srfi-64: Accept symbols as test group names.

[Tomas Volf <~@wolfsden.cz>]

The specification mandates a string, but with rationale suggesting symbols
would be a more natural fit.

> In some ways using symbols would be preferable. However, we want
> human-readable names, and standard Scheme does not provide a way to include
> spaces or mixed-case text in literal symbols.

Add support for symbols as implementation extension.

* module/srfi/srfi-64.scm (%cmp-group-name): New procedure.
(test-end): Use it.
---
 module/srfi/srfi-64.scm | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/module/srfi/srfi-64.scm b/module/srfi/srfi-64.scm
index 1f60a72e5..98fcef645 100644
--- a/module/srfi/srfi-64.scm
+++ b/module/srfi/srfi-64.scm
@@ -522,7 +522,10 @@ returning new test runner.  Defaults to @code{test-runner-simple}.")
                                (1+ (group-executed-count group)))))))
 
 (define* (test-begin suite-name #:optional count)
-  "Enter a new test group."
+  "Enter a new test group.
+
+As implementation extension, in addition to strings, symbols are also
+supported as @var{suite-name}."
   (let* ((r (test-runner-current))
          (r install? (if r
                          (values r                    #f)
@@ -544,6 +547,14 @@ returning new test runner.  Defaults to @code{test-runner-simple}.")
 
     ((test-runner-on-group-begin r) r suite-name count)))
 
+(define (%cmp-group-name a b)
+  (match (list a b)
+    (((? string?) (? string?))
+     (string=? a b))
+    (((? symbol?) (? symbol?))
+     (eq? a b))
+    (_ #f)))
+
 (define* (test-end #:optional suite-name)
   "Leave the current test group."
   (let* ((r (test-runner-current))
@@ -551,7 +562,7 @@ returning new test runner.  Defaults to @code{test-runner-simple}.")
 
     (let ((begin-name (car (test-runner-group-stack r)))
           (end-name   suite-name))
-      (when (and end-name (not (string=? begin-name end-name)))
+      (when (and end-name (not (%cmp-group-name begin-name end-name)))
         ((test-runner-on-bad-end-name r) r begin-name end-name)
         (raise-exception (make-bad-end-name begin-name end-name))))
 
-- 
2.46.0