Hello, Per. Would you mind taking a look at this?
Thanks.
---------- Forwarded message ---------
From: <jaku...@riseup.net>
Date: Thu, Apr 22, 2021 at 7:55 AM
Subject: Bug: Calling (test-end) removes global test-runner
To: <srfi-64@srfi.schemers.org>
SRFI states:
Additionally, *if* the matching test-begin installed a new
test-runner, then the test-end will de-install it [...]
Current implementation removes the installed test-runner
unconditionally, regardless of whether it was set by test-begin or not.
My solution is to put the cleanup function that will unset the
test-runner into a newly created runner's on-final slot.
That way this finalizer will run only if test-begin set its own
test-runner.
From 0db5a8d5e7f8a8c80aada1b115ab332236395301 Mon Sep 17 00:00:00 2001
From: jakub-w <jakub-w@riseup.net>
Date: Thu, 22 Apr 2021 15:13:55 +0200
Subject: [PATCH] Fix a bug with test-end removing globally installed
test-runner
* testing.scm (%test-begin, %test-end): When (test-runner-current) is
not set, create a new one like before but also add a finalizer that
will remove it after the test is finished. Previously the test runner
was getting unset unconditionally.
---
testing.scm | 11 +++++++----
1 file changed, 7 insertions(+), 4 deletions(-)
diff --git a/testing.scm b/testing.scm
index fa66b8b..7633f01 100644
--- a/testing.scm
+++ b/testing.scm
@@ -298,7 +298,11 @@
(define (%test-begin suite-name count)
(if (not (test-runner-current))
- (test-runner-current (test-runner-create)))
+ (let ((r (test-runner-create)))
+ (test-runner-current r)
+ (test-runner-on-final! r
+ (let ((old-final (test-runner-on-final r)))
+ (lambda (r) (old-final r) (test-runner-current #f))))))
(let ((runner (test-runner-current)))
((test-runner-on-group-begin runner) runner suite-name count)
(%test-runner-skip-save! runner
@@ -464,9 +468,8 @@
(%test-runner-fail-list! r (car (%test-runner-fail-save r)))
(%test-runner-fail-save! r (cdr (%test-runner-fail-save r)))
(%test-runner-count-list! r (cdr count-list))
- (cond ((null? (test-runner-group-stack r))
- ((test-runner-on-final r) r)
- (test-runner-current #f))))))
+ (if (null? (test-runner-group-stack r))
+ ((test-runner-on-final r) r)))))
(define-syntax test-group
(syntax-rules ()
--
2.31.1
