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

Fix bug #42713: srfi-64: Reset test-runner-current if done

Browse source 
Reported by Jérémy Korwin-Zmijowski
(https://lists.gnu.org/archive/html/bug-guile/2020-08/msg00010.html).

Fix from
7cf4c01039:

Apply fix from Per Bothner.

In Per's words:

  * testing.scm (%test-end): Reset test-runner-current if done.
  This fixes bug "Loading test source file multiple time without having
  report incrementing" reported to srfi-64 mailing list.

  * srfi-64-test.scm: Update due to recent srfi-64 implementation change.
This commit is contained in:
Daniel Llorens 2020-08-05 12:46:27 +02:00
parent d238566d0e
commit de5d1a7f99
2 changed files with 9 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -433,8 +433,9 @@
(%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))
(if (null? (test-runner-group-stack r)) (cond ((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 ()

8
test-suite/tests/srfi-64-test.scm
View file

@ -483,6 +483,7 @@
'(("x" "x") ("y") () () ("y") (2 1 0 0 1)) '(("x" "x") ("y") () () ("y") (2 1 0 0 1))
(triv-runner (triv-runner
(lambda () (lambda ()
(test-begin "a then b")
(test-begin "a") (test-begin "a")
(test-skip "y") (test-skip "y")
(test-assert "x" #t) ; PASS (test-assert "x" #t) ; PASS
@ -491,6 +492,7 @@
(test-begin "b") (test-begin "b")
(test-assert "x" #t) ; PASS (test-assert "x" #t) ; PASS
(test-assert "y" #f) ; FAIL (test-assert "y" #f) ; FAIL
(test-end)
(test-end)))) (test-end))))
(test-equal (test-equal
@ -498,6 +500,7 @@
'(("x" "x") () () () ("y" "y") (2 0 0 0 2)) '(("x" "x") () () () ("y" "y") (2 0 0 0 2))
(triv-runner (triv-runner
(lambda () (lambda ()
(test-begin "a then b")
(test-skip "y") (test-skip "y")
(test-begin "a") (test-begin "a")
(test-assert "x" #t) ; PASS (test-assert "x" #t) ; PASS
@ -506,6 +509,7 @@
(test-begin "b") (test-begin "b")
(test-assert "x" #t) ; PASS (test-assert "x" #t) ; PASS
(test-assert "y" #f) ; SKIP (test-assert "y" #f) ; SKIP
(test-end)
(test-end)))) (test-end))))
(test-end);6.3 (test-end);6.3
@ -809,8 +813,8 @@
(test-assert "x" #t) (test-assert "x" #t)
(test-begin "a") (test-begin "a")
(test-assert #t) (test-assert #t)
(test-end) (test-assert "y" #f)
(test-assert "y" #f)))) (test-end))))
(test-end) ; 8.8 (test-end) ; 8.8