diff options
author | Tomas Volf <~@wolfsden.cz> | 2024-10-26 18:06:51 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2024-10-26 19:44:40 +0200 |
commit | 1a5e35f0eb9a9160d931b6a4a9f1764e65b7e5b8 (patch) | |
tree | 54e18080928aa7d9a56898cdcf605915934b0c31 | |
parent | 242e8698c2fdfada96a136abde5156bac3dbc6c9 (diff) | |
download | guile-1a5e35f0eb9a9160d931b6a4a9f1764e65b7e5b8.tar.gz |
srfi-64: Accept symbols as test group names.
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 an implementation extension and for backwards
compatibility with the reference implementation.
* module/srfi/srfi-64.scm (%cmp-group-name): New procedure.
(test-end): Use it.
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Reported-by: Daniel Llorens <lloda@sarc.name>
-rw-r--r-- | module/srfi/srfi-64.scm | 15 |
1 files 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)))) |