From 58dd295deed6d5d04f09638646d4f5be0ca0a123 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Mon, 16 Oct 2017 17:44:19 +0200
Subject: [PATCH 1/2] Fix test-end to not end the entire process but the
 current group only

This makes it consistent with the test egg, and ensures some more
tests actually get run, which were basically dead tests before.
---
 tests/environment-tests.scm     |  2 ++
 tests/executable-tests.scm      |  2 ++
 tests/functor-tests.scm         |  4 +++-
 tests/match-test.scm            |  1 +
 tests/module-tests-compiled.scm |  2 ++
 tests/module-tests.scm          |  1 +
 tests/numbers-test-ashinn.scm   |  2 ++
 tests/numbers-test-gauche.scm   |  4 ++--
 tests/numbers-test.scm          |  1 +
 tests/port-tests.scm            |  4 +++-
 tests/test-find-files.scm       |  2 ++
 tests/test-irregex.scm          |  5 +++--
 tests/test.scm                  | 31 +++++++++++++++++++++++++++++--
 13 files changed, 53 insertions(+), 8 deletions(-)

diff --git a/tests/environment-tests.scm b/tests/environment-tests.scm
index 61f50f03..ef45b47b 100644
--- a/tests/environment-tests.scm
+++ b/tests/environment-tests.scm
@@ -53,3 +53,5 @@
 (test-error (eval 'baz format-env))
 
 (test-end)
+
+(test-exit)
diff --git a/tests/executable-tests.scm b/tests/executable-tests.scm
index f1ebc82a..d98f121f 100644
--- a/tests/executable-tests.scm
+++ b/tests/executable-tests.scm
@@ -30,3 +30,5 @@
               (read-symbolic-link* program-path)))
 
 (test-end)
+
+(test-exit)
diff --git a/tests/functor-tests.scm b/tests/functor-tests.scm
index 7fa5531f..61193796 100644
--- a/tests/functor-tests.scm
+++ b/tests/functor-tests.scm
@@ -5,7 +5,7 @@
 
 
 (include "test.scm")
-(test-begin)
+(test-begin "functor tests")
 
 ;;
 
@@ -240,3 +240,5 @@
 ;;
 
 (test-end)
+
+(test-exit)
diff --git a/tests/match-test.scm b/tests/match-test.scm
index d3dd2437..20568bfa 100644
--- a/tests/match-test.scm
+++ b/tests/match-test.scm
@@ -116,3 +116,4 @@
 
 (test-end "match")
 
+(test-exit)
diff --git a/tests/module-tests-compiled.scm b/tests/module-tests-compiled.scm
index 66031acb..09b2e94c 100644
--- a/tests/module-tests-compiled.scm
+++ b/tests/module-tests-compiled.scm
@@ -41,3 +41,5 @@
 
 
 (test-end "modules")
+
+(test-exit)
diff --git a/tests/module-tests.scm b/tests/module-tests.scm
index 33a4b15e..bed2049f 100644
--- a/tests/module-tests.scm
+++ b/tests/module-tests.scm
@@ -374,3 +374,4 @@
 
 (test-end "modules")
 
+(test-exit)
diff --git a/tests/numbers-test-ashinn.scm b/tests/numbers-test-ashinn.scm
index 713cae0c..9fa886ff 100644
--- a/tests/numbers-test-ashinn.scm
+++ b/tests/numbers-test-ashinn.scm
@@ -144,3 +144,5 @@
   (test-assert (bit->boolean #x10000000000000000 64)))
 
 (test-end)
+
+(test-exit)
diff --git a/tests/numbers-test-gauche.scm b/tests/numbers-test-gauche.scm
index 61423410..c14f4b90 100644
--- a/tests/numbers-test-gauche.scm
+++ b/tests/numbers-test-gauche.scm
@@ -48,7 +48,7 @@
 
 ;; Gauche compat
 
-(import bitwise)
+(import bitwise (chicken port) (chicken format) (chicken string))
 
 (define (greatest-fixnum) most-positive-fixnum)
 (define (least-fixnum) most-negative-fixnum)
@@ -2118,4 +2118,4 @@
 
 (test-end)
 
-(test-end)
+(test-exit)
diff --git a/tests/numbers-test.scm b/tests/numbers-test.scm
index da3c70b3..58586676 100644
--- a/tests/numbers-test.scm
+++ b/tests/numbers-test.scm
@@ -1657,3 +1657,4 @@
 (test-end)
 
 ;(unless (zero? (test-failure-count)) (exit 1))
+(test-exit)
diff --git a/tests/port-tests.scm b/tests/port-tests.scm
index 1330b443..90ffcabf 100644
--- a/tests/port-tests.scm
+++ b/tests/port-tests.scm
@@ -2,7 +2,7 @@
         file flonum format io port posix srfi-4 tcp)
 
 (include "test.scm")
-(test-begin)
+(test-begin "ports")
 
 (define-syntax assert-error
   (syntax-rules ()
@@ -436,3 +436,5 @@ EOF
 ;;;
 
 (test-end)
+
+(test-exit)
diff --git a/tests/test-find-files.scm b/tests/test-find-files.scm
index 08866b74..f09c02a1 100644
--- a/tests/test-find-files.scm
+++ b/tests/test-find-files.scm
@@ -215,3 +215,5 @@
 
 (change-directory "..")
 (delete-directory "find-files-test-dir" #t)
+
+(test-exit)
diff --git a/tests/test-irregex.scm b/tests/test-irregex.scm
index b3e1520e..19218bd8 100644
--- a/tests/test-irregex.scm
+++ b/tests/test-irregex.scm
@@ -59,7 +59,7 @@
 	 splt)
 	(warning "invalid regex test line" line))))
 
-(test-begin)
+(test-begin "basic irregex tests")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; basic irregex
@@ -511,7 +511,7 @@
 
 ;;; UTF-8 tests
 
-(test-begin)
+(test-begin "utf-8 tests")
 
 (test-assert (irregex-search "(?u:<..>)" "<漢字>"))
 (test-assert (irregex-search "(?u:<.*>)" "<漢字>"))
@@ -541,3 +541,4 @@
 
 (test-end)
 
+(test-exit)
diff --git a/tests/test.scm b/tests/test.scm
index 5c886f5d..fc67fc51 100644
--- a/tests/test.scm
+++ b/tests/test.scm
@@ -5,9 +5,13 @@
 (import (only chicken.string ->string))
 (import time) ; current-milliseconds
 
+(define *current-group-name* "")
 (define *pass* 0)
 (define *fail* 0)
 (define *start* 0)
+(define *total-pass* 0)
+(define *total-fail* 0)
+(define *total-start* 0)
 (define *fail-token* (gensym))
 
 (define (run-test name thunk expect eq pass-msg fail-msg)
@@ -30,9 +34,15 @@
       (else (display (car ls)) (lp (cdr ls))))))
 
 (define (test-begin . o)
+  (set! *current-group-name* (if (null? o) "<unnamed>" (car o)))
+  (print "== " *current-group-name* " ==")
+  (set! *total-pass* (+ *total-pass* *pass*))
+  (set! *total-fail* (+ *total-fail* *fail*))
   (set! *pass* 0)
   (set! *fail* 0)
-  (set! *start* (current-milliseconds)))
+  (set! *start* (current-milliseconds))
+  (when (= 0 *total-start*)
+    (set! *total-start* (current-milliseconds))))
 
 (define (format-float n prec)
   (let* ((str (number->string n))
@@ -68,8 +78,25 @@
 	   "%) tests passed")
     (print "  " *fail* " ("
 	   (format-percent *fail* total)
+	   "%) tests failed"))
+    (print "-- " *current-group-name* " --\n\n"))
+
+(define (test-exit . o)
+  (print " TOTALS: ")
+  (set! *total-pass* (+ *total-pass* *pass*)) ; should be 0
+  (set! *total-fail* (+ *total-fail* *fail*)) ; should be 0
+  (let ((end (current-milliseconds))
+        (total (+ *total-pass* *total-fail*)))
+    (print "  " total " tests completed in "
+	   (format-float (exact->inexact (/ (- end *total-start*) 1000)) 3)
+	   " seconds")
+    (print "  " *total-pass* " ("
+	   (format-percent *total-pass* total)
+	   "%) tests passed")
+    (print "  " *total-fail* " ("
+	   (format-percent *total-fail* total)
 	   "%) tests failed")
-    (exit (if (zero? *fail*) 0 1))))
+    (exit (if (zero? *total-fail*) 0 1))))
 
 (define (run-equal name thunk expect eq)
   (run-test name thunk expect eq
-- 
2.11.0