[Guile-commits] branch master updated: [srfi-64] Fix a bug with test-end removing globally installed test-runner

[Daniel Llorens]

This is an automated email from the git hooks/post-receive script.

lloda pushed a commit to branch master
in repository guile.

The following commit(s) were added to refs/heads/master by this push:
     new f10bc1a  [srfi-64] Fix a bug with test-end removing globally installed 
test-runner
f10bc1a is described below

commit f10bc1a864c3ca63bf40062cf25aed8630d814ce
Author: jakub-w <jakub-w@riseup.net>
AuthorDate: Thu Apr 22 15:13:55 2021 +0200

    [srfi-64] 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.
    
    See https://srfi-email.schemers.org/srfi-64/msg/16468240/
---
 module/srfi/srfi-64/testing.scm | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/module/srfi/srfi-64/testing.scm b/module/srfi/srfi-64/testing.scm
index 37792cd..cdaab14 100644
--- a/module/srfi/srfi-64/testing.scm
+++ b/module/srfi/srfi-64/testing.scm
@@ -278,7 +278,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
@@ -433,9 +437,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 ()