mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

[srfi-64] Fix a bug with test-end removing globally installed test-runner

Browse source 
* 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/
This commit is contained in:
jakub-w 2021-04-22 15:13:55 +02:00 • committed by Daniel Llorens
parent 5969490f55
commit f10bc1a864
1 changed files with 7 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

11
module/srfi/srfi-64/testing.scm
View file

@ -278,7 +278,11 @@
(define (%test-begin suite-name count) (define (%test-begin suite-name count)
(if (not (test-runner-current)) (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))) (let ((runner (test-runner-current)))
((test-runner-on-group-begin runner) runner suite-name count) ((test-runner-on-group-begin runner) runner suite-name count)
(%test-runner-skip-save! runner (%test-runner-skip-save! runner
@ -433,9 +437,8 @@
(%test-runner-fail-list! r (car (%test-runner-fail-save r))) (%test-runner-fail-list! r (car (%test-runner-fail-save r)))
(%test-runner-fail-save! r (cdr (%test-runner-fail-save r))) (%test-runner-fail-save! r (cdr (%test-runner-fail-save r)))
(%test-runner-count-list! r (cdr count-list)) (%test-runner-count-list! r (cdr count-list))
(cond ((null? (test-runner-group-stack r)) (if (null? (test-runner-group-stack r))
((test-runner-on-final r) r) ((test-runner-on-final r) r)))))
(test-runner-current #f))))))
(define-syntax test-group (define-syntax test-group
(syntax-rules () (syntax-rules ()