From de5d1a7f99b8e952b115237ebc29633062f99bb9 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <lloda@sarc.name>
Date: Wed, 5 Aug 2020 12:46:27 +0200
Subject: [PATCH] Fix bug #42713: srfi-64: Reset test-runner-current if done
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

Fix from
https://github.com/scheme-requests-for-implementation/srfi-64/commit/7cf4c010398850b45f5a6939bb73f747605a0513:

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.
---
 module/srfi/srfi-64/testing.scm   | 5 +++--
 test-suite/tests/srfi-64-test.scm | 8 ++++++--
 2 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/module/srfi/srfi-64/testing.scm b/module/srfi/srfi-64/testing.scm
index d686662bf..37792cd0f 100644
--- a/module/srfi/srfi-64/testing.scm
+++ b/module/srfi/srfi-64/testing.scm
@@ -433,8 +433,9 @@
       (%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))
-      (if (null? (test-runner-group-stack r))
-	  ((test-runner-on-final r) r)))))
+      (cond ((null? (test-runner-group-stack r))
+             ((test-runner-on-final r) r)
+             (test-runner-current #f))))))
 
 (define-syntax test-group
   (syntax-rules ()
diff --git a/test-suite/tests/srfi-64-test.scm b/test-suite/tests/srfi-64-test.scm
index 264c86f47..ca0b58943 100644
--- a/test-suite/tests/srfi-64-test.scm
+++ b/test-suite/tests/srfi-64-test.scm
@@ -483,6 +483,7 @@
  '(("x" "x") ("y") () () ("y") (2 1 0 0 1))
  (triv-runner
   (lambda ()
+    (test-begin "a then b")
     (test-begin "a")
     (test-skip "y")
     (test-assert "x" #t)      ; PASS
@@ -491,6 +492,7 @@
     (test-begin "b")
     (test-assert "x" #t)      ; PASS
     (test-assert "y" #f)      ; FAIL
+    (test-end)
     (test-end))))
 
 (test-equal
@@ -498,6 +500,7 @@
  '(("x" "x") () () () ("y" "y") (2 0 0 0 2))
  (triv-runner
   (lambda ()
+    (test-begin "a then b")
     (test-skip "y")
     (test-begin "a")
     (test-assert "x" #t)      ; PASS
@@ -506,6 +509,7 @@
     (test-begin "b")
     (test-assert "x" #t)      ; PASS
     (test-assert "y" #f)      ; SKIP
+    (test-end)
     (test-end))))
 
 (test-end);6.3
@@ -809,8 +813,8 @@
                (test-assert "x" #t)
                (test-begin "a")
                (test-assert #t)
-               (test-end)
-               (test-assert "y" #f))))
+               (test-assert "y" #f)
+               (test-end))))
 
 (test-end) ; 8.8