~ chicken-core (chicken-5) 134f96615de8bcb2baa2691c35d592c4cef013a4
commit 134f96615de8bcb2baa2691c35d592c4cef013a4
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Mon Oct 16 17:44:19 2017 +0200
Commit: Kooda <kooda@upyum.com>
CommitDate: Wed Oct 25 14:19:27 2017 +0200
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.
Signed-off-by: Kooda <kooda@upyum.com>
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 e34cce4a..a1df5dcf 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
Trap