* [PATCH 2/5] build: Add a Guile custom test driver using SRFI-64.
2016-03-23 23:38 [PATCH 0/5] Automake custom test driver using SRFI-64 Mathieu Lirzin
2016-03-23 23:38 ` [PATCH 1/5] tests: Silence %cpio-program Mathieu Lirzin
@ 2016-03-23 23:38 ` Mathieu Lirzin
2016-03-23 23:38 ` [PATCH 3/5] tests: Silence guix-daemon Mathieu Lirzin
` (6 subsequent siblings)
8 siblings, 0 replies; 17+ messages in thread
From: Mathieu Lirzin @ 2016-03-23 23:38 UTC (permalink / raw)
To: guix-devel
Before that '.log' files for scheme tests were fragmented and not
included in test-suite.log. This unifies the semantics of SRFI-64 API
with Automake test suite.
* build-aux/test-driver.scm: New file.
* Makefile.am (SCM_LOG_DRIVER, AM_SCM_LOG_DRIVER_FLAGS): New variables.
(SCM_LOG_COMPILER, AM_SCM_LOG_FLAGS): Delete variables.
(AM_TESTS_ENVIRONMENT): Set GUILE_AUTO_COMPILE to 0.
* doc/guix.texi (Running the Test Suite): Describe how to display the
detailed results. Bug reports don't require including additional '.log'
files.
* tests/base32.scm, tests/build-utils.scm, tests/builders.scm,
tests/challenge.scm, tests/cpan.scm, tests/cpio.scm, tests/cran.scm,
tests/cve.scm, tests/derivations.scm, tests/elpa.scm,
tests/file-systems.scm, tests/gem.scm, tests/gexp.scm,
tests/gnu-maintenance.scm, tests/graph.scm, tests/gremlin.scm,
tests/hackage.scm, tests/hash.scm, tests/import-utils.scm,
tests/lint.scm, tests/monads.scm, tests/nar.scm, tests/packages.scm,
tests/pk-crypto.scm, tests/pki.scm, tests/profiles.scm,
tests/publish.scm, tests/pypi.scm, tests/records.scm,
tests/scripts-build.scm, tests/scripts.scm, tests/services.scm,
tests/sets.scm, tests/size.scm, tests/snix.scm, tests/store.scm,
tests/substitute.scm, tests/syscalls.scm, tests/system.scm,
tests/ui.scm, tests/union.scm, tests/utils.scm: Don't exit at the end of
test groups.
* tests/containers.scm: Likewise. Use 'test-skip' instead of exiting
with error code 77.
---
Makefile.am | 7 +-
build-aux/test-driver.scm | 195 ++++++++++++++++++++++++++++++++++++++++++++++
doc/guix.texi | 16 ++--
tests/base32.scm | 3 -
tests/build-utils.scm | 3 -
tests/builders.scm | 3 -
tests/challenge.scm | 3 -
tests/containers.scm | 9 +--
tests/cpan.scm | 3 -
tests/cpio.scm | 3 -
tests/cran.scm | 3 -
tests/cve.scm | 3 -
tests/derivations.scm | 3 -
tests/elpa.scm | 3 -
tests/file-systems.scm | 3 -
tests/gem.scm | 3 -
tests/gexp.scm | 3 -
tests/gnu-maintenance.scm | 3 -
tests/graph.scm | 3 -
tests/gremlin.scm | 3 -
tests/hackage.scm | 3 -
tests/hash.scm | 3 -
tests/import-utils.scm | 3 -
tests/lint.scm | 3 -
tests/monads.scm | 3 -
tests/nar.scm | 3 -
tests/packages.scm | 3 -
tests/pk-crypto.scm | 3 -
tests/pki.scm | 3 -
tests/profiles.scm | 3 -
tests/publish.scm | 3 -
tests/pypi.scm | 3 -
tests/records.scm | 3 -
tests/scripts-build.scm | 3 -
tests/scripts.scm | 3 -
tests/services.scm | 3 -
tests/sets.scm | 3 -
tests/size.scm | 3 -
tests/snix.scm | 3 -
tests/store.scm | 3 -
tests/substitute.scm | 3 -
tests/syscalls.scm | 3 -
tests/system.scm | 3 -
tests/ui.scm | 3 -
tests/union.scm | 3 -
tests/utils.scm | 3 -
46 files changed, 213 insertions(+), 140 deletions(-)
create mode 100644 build-aux/test-driver.scm
diff --git a/Makefile.am b/Makefile.am
index 06700de..4b665a6 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -293,10 +293,11 @@ endif BUILD_DAEMON
TESTS = $(SCM_TESTS) $(SH_TESTS)
-AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)"
+AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" GUILE_AUTO_COMPILE=0
-SCM_LOG_COMPILER = $(top_builddir)/test-env $(GUILE)
-AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)"
+SCM_LOG_DRIVER = $(top_builddir)/test-env $(GUILE) --no-auto-compile \
+ -e main $(top_srcdir)/build-aux/test-driver.scm
+AM_SCM_LOG_DRIVER_FLAGS = --brief=yes
SH_LOG_COMPILER = $(top_builddir)/test-env $(SHELL)
AM_SH_LOG_FLAGS = -x -e
diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
new file mode 100644
index 0000000..7981929
--- /dev/null
+++ b/build-aux/test-driver.scm
@@ -0,0 +1,195 @@
+;;;; test-driver.scm - SRFI-64 custom driver for GNU Automake test suites
+
+(define script-version "2016-03-23.22") ;UTC
+
+;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
+;;;
+;;; This program is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;;; Commentary:
+;;;
+;;; This script provides a custom test driver for GNU Automake using the
+;;; SRFI-64 Scheme API for test suites.
+;;;
+;;;; Code:
+
+(use-modules (ice-9 getopt-long)
+ (ice-9 pretty-print)
+ (srfi srfi-26)
+ (srfi srfi-64))
+
+(define (show-help)
+ (display "Usage:
+ test-driver --test-name=NAME --log-file=PATH --trs-file=PATH
+ [--expect-failure={yes|no}] [--color-tests={yes|no}]
+ [--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--]
+ TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS]
+The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n"))
+
+(define %options
+ '((test-name (value #t))
+ (log-file (value #t))
+ (trs-file (value #t))
+ (color-tests (value #t))
+ (expect-failure (value #t)) ;XXX: not implemented yet
+ (enable-hard-errors (value #t)) ;XXX: not implemented in SRFI-64
+ (brief (value #t))
+ (help (single-char #\h) (value #f))
+ (version (single-char #\V) (value #f))))
+
+(define (option->boolean options key)
+ "Return #t if the value associated with KEY in OPTIONS is \"yes\"."
+ (and=> (option-ref options key #f) (cut string=? <> "yes")))
+
+(define* (test-display field value #:optional (port (current-output-port))
+ #:key pretty?)
+ "Display \"FIELD: VALUE\\n\" on PORT."
+ (if pretty?
+ (begin
+ (format port "~A:~%" field)
+ (pretty-print value port #:per-line-prefix "+ "))
+ (format port "~A: ~A~%" field value)))
+
+(define* (result->string symbol #:key colorize)
+ "Return SYMBOL as an upper case string. Use colors when COLORIZE is #t."
+ (let ((result (string-upcase (symbol->string symbol))))
+ (if colorize
+ (string-append (case symbol
+ ((pass) "^[[0;32m") ;green
+ ((xfail) "^[[1;32m") ;light green
+ ((skip) "^[[1;34m") ;blue
+ ((fail xpass) "^[[0;31m") ;red
+ ((error) "^[[0;35m")) ;magenta
+ result
+ "^[[m") ;no color
+ result)))
+
+(define* (test-runner-gnu test-name #:key color-tests brief out-port trs-port)
+ "Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the
+file name of the current the test. COLOR-TESTS and BRIEF are booleans.
+OUT-PORT and TRS-PORT must be output ports. The current output port is
+supposed to be redirected to a '.log' file."
+
+ (define (test-on-test-begin-gnu runner)
+ ;; Procedure called at the start of an individual test-case, before the
+ ;; test expression (and expected value) are evaluated.
+ (let ((result (cute assq-ref (test-result-alist runner) <>)))
+ (test-display "test-name" (result 'test-name))
+ (test-display "location"
+ (string-append (result 'source-file) ":"
+ (number->string (result 'source-line))))
+ (test-display "source" (result 'source-form) #:pretty? #t)))
+
+ (define (test-on-test-end-gnu runner)
+ ;; Procedure called at the end of an individual testcase, when the result
+ ;; of the test is available.
+ (let* ((results (test-result-alist runner))
+ (result? (cut assq <> results))
+ (result (cut assq-ref results <>)))
+ (unless brief
+ ;; Display the result of each test case on the console.
+ (test-display
+ (result->string (test-result-kind runner) #:colorize color-tests)
+ (string-append test-name " - " (test-runner-test-name runner))
+ out-port))
+ (when (result? 'expected-value)
+ (test-display "expected-value" (result 'expected-value)))
+ (when (result? 'expected-error)
+ (test-display "expected-error" (result 'expected-error) #:pretty? #t))
+ (when (result? 'actual-value)
+ (test-display "actual-value" (result 'actual-value)))
+ (when (result? 'actual-error)
+ (test-display "actual-error" (result 'actual-error) #:pretty? #t))
+ (test-display "result" (result->string (result 'result-kind)))
+ (newline)
+ (test-display ":test-result"
+ (string-append (result->string (test-result-kind runner))
+ " " (test-runner-test-name runner))
+ trs-port)))
+
+ (define (test-on-group-end-gnu runner)
+ ;; Procedure called by a 'test-end', including at the end of a test-group.
+ (let ((fail (or (positive? (test-runner-fail-count runner))
+ (positive? (test-runner-xpass-count runner))))
+ (skip (or (positive? (test-runner-skip-count runner))
+ (positive? (test-runner-xfail-count runner)))))
+ ;; XXX: The global results need some refinements for XPASS
+ (test-display ":global-test-result"
+ (if fail "FAIL" (if skip "SKIP" "PASS"))
+ trs-port)
+ (test-display ":recheck"
+ (if fail "yes" "no")
+ trs-port)
+ (test-display ":copy-in-global-log"
+ (if (or fail skip) "yes" "no")
+ trs-port)
+ (when brief
+ ;; Display the global test group result on the console.
+ (test-display (result->string (if fail 'fail (if skip 'skip 'pass))
+ #:colorize color-tests)
+ test-name
+ out-port))
+ #f))
+
+ (let ((runner (test-runner-null)))
+ (test-runner-on-test-begin! runner test-on-test-begin-gnu)
+ (test-runner-on-test-end! runner test-on-test-end-gnu)
+ (test-runner-on-group-end! runner test-on-group-end-gnu)
+ (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple)
+ runner))
+
+\f
+;;;
+;;; Entry point.
+;;;
+
+(define (main . args)
+ (let ((opts (getopt-long (command-line) %options)))
+ (cond
+ ((option-ref opts 'help #f)
+ (show-help))
+ ((option-ref opts 'version #f)
+ (format #t "test-driver.scm ~A" script-version))
+ (else
+ (let ((log (open-output-file (option-ref opts 'log-file "")))
+ (trs (open-output-file (option-ref opts 'trs-file "")))
+ (out (current-output-port)))
+ (setvbuf out _IOLBF)
+ (test-with-runner
+ (test-runner-gnu (option-ref opts 'test-name #f)
+ #:color-tests (option->boolean opts 'color-tests)
+ #:brief (option->boolean opts 'brief)
+ #:out-port out
+ #:trs-port trs)
+ (dynamic-wind
+ (lambda ()
+ (set-current-output-port log)
+ (set-current-error-port log))
+ (lambda ()
+ (parameterize ((current-warning-port log))
+ (load-from-path (option-ref opts 'test-name #f))))
+ (lambda ()
+ (close-port log)
+ (close-port trs)))))))
+ (exit 0)))
+
+;;; Local Variables:
+;;; eval: (add-hook 'write-file-functions 'time-stamp)
+;;; time-stamp-start: "(define script-version \""
+;;; time-stamp-format: "%:y-%02m-%02d.%02H"
+;;; time-stamp-time-zone: "UTC"
+;;; time-stamp-end: "\") ;UTC"
+;;; End:
+
+;;;; test-driver.scm ends here.
diff --git a/doc/guix.texi b/doc/guix.texi
index 186b850..1aa616e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -576,12 +576,18 @@ It is also possible to run a subset of the tests by defining the
make check TESTS="tests/store.scm tests/cpio.scm"
@end example
+By default, tests results are displayed at a file level. In order to
+see the details of every individual test cases, it is possible to define
+the @code{SCM_LOG_DRIVER_FLAGS} makefile variable as in this example:
+
+@example
+make check TESTS="tests/base64.scm" SCM_LOG_DRIVER_FLAGS="--brief=no"
+@end example
+
Upon failure, please email @email{bug-guix@@gnu.org} and attach the
-@file{test-suite.log} file. When @file{tests/@var{something}.scm}
-fails, please also attach the @file{@var{something}.log} file available
-in the top-level build directory. Please specify the Guix version being
-used as well as version numbers of the dependencies
-(@pxref{Requirements}) in your message.
+@file{test-suite.log} file. Please specify the Guix version being used
+as well as version numbers of the dependencies (@pxref{Requirements}) in
+your message.
@node Setting Up the Daemon
@section Setting Up the Daemon
diff --git a/tests/base32.scm b/tests/base32.scm
index dcd926f..194f8da 100644
--- a/tests/base32.scm
+++ b/tests/base32.scm
@@ -101,6 +101,3 @@
l))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index b0a4d15..cc96738 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -141,6 +141,3 @@
(equal? str "hello world\n")))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/builders.scm b/tests/builders.scm
index a7c3e42..bb9e0fa 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -113,6 +113,3 @@
(file-exists? (string-append out "/bin/hello")))))
(test-end "builders")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/challenge.scm b/tests/challenge.scm
index e53cacd..9505042 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -106,9 +106,6 @@
(test-end)
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
;;; Local Variables:
;;; eval: (put 'with-derivation-narinfo* 'scheme-indent-function 2)
;;; End:
diff --git a/tests/containers.scm b/tests/containers.scm
index 12982a6..c11cdd1 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -26,14 +26,14 @@
(define (assert-exit x)
(primitive-exit (if x 0 1)))
+(test-begin "containers")
+
;; Skip these tests unless user namespaces are available and the setgroups
;; file (introduced in Linux 3.19 to address a security issue) exists.
(unless (and (user-namespace-supported?)
(unprivileged-user-namespace-supported?)
(setgroups-supported?))
- (exit 77))
-
-(test-begin "containers")
+ (test-skip 7))
(test-assert "call-with-container, exit with 0 when there is no error"
(zero?
@@ -142,6 +142,3 @@
(zero? result)))))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/cpan.scm b/tests/cpan.scm
index 5836841..5d56f0b 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -98,6 +98,3 @@
(pk 'fail x #f)))))
(test-end "cpan")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/cpio.scm b/tests/cpio.scm
index b6ae1b2..f3384d1 100644
--- a/tests/cpio.scm
+++ b/tests/cpio.scm
@@ -80,6 +80,3 @@
(stat:size (stat file))))))))))))))
(test-end "cpio")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/cran.scm b/tests/cran.scm
index 83d2e7f..896c5af 100644
--- a/tests/cran.scm
+++ b/tests/cran.scm
@@ -131,6 +131,3 @@ lines. And: this line continues the description.")
(pk 'fail x #f))))))
(test-end "cran")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/cve.scm b/tests/cve.scm
index 26bc560..26e710c 100644
--- a/tests/cve.scm
+++ b/tests/cve.scm
@@ -64,6 +64,3 @@
(lookup "openoffice.org" "2.3.0"))))
(test-end "cve")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index a52142e..cb7196e 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1008,6 +1008,3 @@
(call-with-input-file out get-string-all))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/elpa.scm b/tests/elpa.scm
index e8adde3..46c6ac2 100644
--- a/tests/elpa.scm
+++ b/tests/elpa.scm
@@ -104,6 +104,3 @@ information about package NAME. (Function 'elpa-package-info'.)"
(eval-test-with-elpa "auctex"))
(test-end "elpa")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/file-systems.scm b/tests/file-systems.scm
index c36509b..aed27e8 100644
--- a/tests/file-systems.scm
+++ b/tests/file-systems.scm
@@ -51,6 +51,3 @@
(equal? form '(uuid "foobar"))))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/gem.scm b/tests/gem.scm
index ebce809..0b37c70 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -77,6 +77,3 @@
(pk 'fail x #f)))))
(test-end "gem")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 75b907a..db0ffd2 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -784,9 +784,6 @@
(test-end "gexp")
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
;; Local Variables:
;; eval: (put 'test-assertm 'scheme-indent-function 1)
;; End:
diff --git a/tests/gnu-maintenance.scm b/tests/gnu-maintenance.scm
index e729613..4f2f1ae 100644
--- a/tests/gnu-maintenance.scm
+++ b/tests/gnu-maintenance.scm
@@ -39,6 +39,3 @@
("gnutls" "gnutls-3.2.18-w32.zip")))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/graph.scm b/tests/graph.scm
index 4205b9b..3231719 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -276,6 +276,3 @@ edges."
(list p1a p1b p0)))))))
(test-end "graph")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/gremlin.scm b/tests/gremlin.scm
index dc9f78c..2885554 100644
--- a/tests/gremlin.scm
+++ b/tests/gremlin.scm
@@ -64,6 +64,3 @@
"ORIGIN/foo")))
(test-end "gremlin")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/hackage.scm b/tests/hackage.scm
index b608ccd..d1ebe37 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -160,6 +160,3 @@ library
(x (pk 'fail x #f))))
(test-end "hackage")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/hash.scm b/tests/hash.scm
index 9bcd694..8039549 100644
--- a/tests/hash.scm
+++ b/tests/hash.scm
@@ -126,6 +126,3 @@ In Guile <= 2.0.9, CBIPs were always fully buffered, so the
(list hello hash world))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 0836581..3b11875 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -34,6 +34,3 @@
(beautify-description "A function to establish world peace"))
(test-end "import-utils")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/lint.scm b/tests/lint.scm
index 54be50d..4f01964 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -581,9 +581,6 @@ requests."
(test-end "lint")
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
;; Local Variables:
;; eval: (put 'with-http-server 'scheme-indent-function 1)
;; eval: (put 'with-warnings 'scheme-indent-function 0)
diff --git a/tests/monads.scm b/tests/monads.scm
index 4112bcb..18bf411 100644
--- a/tests/monads.scm
+++ b/tests/monads.scm
@@ -258,6 +258,3 @@
'())))
(test-end "monads")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/nar.scm b/tests/nar.scm
index e24a638..9796980 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -320,9 +320,6 @@
(test-end "nar")
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
;;; Local Variables:
;;; eval: (put 'with-file-tree 'scheme-indent-function 2)
;;; End:
diff --git a/tests/packages.scm b/tests/packages.scm
index 823ede1..94e8150 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -799,9 +799,6 @@
(test-end "packages")
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
;;; Local Variables:
;;; eval: (put 'dummy-package 'scheme-indent-function 1)
;;; End:
diff --git a/tests/pk-crypto.scm b/tests/pk-crypto.scm
index f5008f3..5024a15 100644
--- a/tests/pk-crypto.scm
+++ b/tests/pk-crypto.scm
@@ -287,6 +287,3 @@
(canonical-sexp->sexp (sexp->canonical-sexp sexp))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/pki.scm b/tests/pki.scm
index 51f2119..876ad98 100644
--- a/tests/pki.scm
+++ b/tests/pki.scm
@@ -119,6 +119,3 @@
(corrupt-signature 'c))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 6714dfc..fc1dfd2 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -320,9 +320,6 @@
(test-end "profiles")
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
;;; Local Variables:
;;; eval: (put 'dummy-package 'scheme-indent-function 1)
;;; End:
diff --git a/tests/publish.scm b/tests/publish.scm
index 6c710fe..6645286 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -121,6 +121,3 @@ References: ~a~%"
(response-code (http-get (publish-uri (string-append "/nar/invalid"))))))
(test-end "publish")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/pypi.scm b/tests/pypi.scm
index cf351a5..e463467 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -106,6 +106,3 @@ baz > 13.37")
(pk 'fail x #f)))))
(test-end "pypi")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/records.scm b/tests/records.scm
index 800ed03..c6f85d4 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -305,6 +305,3 @@ Description: 1st line,
'("a")))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index cf9770e..e48c8da 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -103,6 +103,3 @@
(eq? dep findutils)))))))))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/scripts.scm b/tests/scripts.scm
index 3bf41ae..3901710 100644
--- a/tests/scripts.scm
+++ b/tests/scripts.scm
@@ -64,9 +64,6 @@
(test-end "scripts")
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
;;; Local Variables:
;;; eval: (put 'with-environment-variable 'scheme-indent-function 2)
;;; End:
diff --git a/tests/services.scm b/tests/services.scm
index 3635549..477a197 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -119,6 +119,3 @@
(null? (e s3)))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/sets.scm b/tests/sets.scm
index 0a89591..cdb7efe 100644
--- a/tests/sets.scm
+++ b/tests/sets.scm
@@ -47,6 +47,3 @@
(set-contains? s3 b))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/size.scm b/tests/size.scm
index a110604..fcd5902 100644
--- a/tests/size.scm
+++ b/tests/size.scm
@@ -88,9 +88,6 @@
(test-end "size")
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
;;; Local Variables:
;;; eval: (put 'match* 'scheme-indent-function 1)
;;; End:
diff --git a/tests/snix.scm b/tests/snix.scm
index a66b2c7..4c31e33 100644
--- a/tests/snix.scm
+++ b/tests/snix.scm
@@ -71,6 +71,3 @@
(pk 'fail x #f))))
(test-end "snix")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/store.scm b/tests/store.scm
index f7db7df..eeadcb9 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -911,6 +911,3 @@
(path-info-deriver (query-path-info %store o))))))
(test-end "store")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 9d907e7..69b272f 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -275,9 +275,6 @@ a file for NARINFO."
(test-end "substitute")
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
-
;;; Local Variables:
;;; eval: (put 'with-narinfo 'scheme-indent-function 1)
;;; eval: (put 'test-quit 'scheme-indent-function 2)
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index a57a9ca..c5e9f8e 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -241,6 +241,3 @@
(lo (interface-address lo)))))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/system.scm b/tests/system.scm
index 7e016a6..b935bd0 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -72,6 +72,3 @@
(eq? gnu (operating-system-store-file-system os))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/ui.scm b/tests/ui.scm
index f28e623..51577ac 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -250,6 +250,3 @@ Second line" 24))
(show-manifest-transaction store m t)))))))))
(test-end "ui")
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/union.scm b/tests/union.scm
index 22ba67c..cccf397 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -125,6 +125,3 @@
(eq? 'directory (stat:type (lstat "bin"))))))))
(test-end)
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
diff --git a/tests/utils.scm b/tests/utils.scm
index 67b3724..6b77255 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -336,6 +336,3 @@
(test-end)
(false-if-exception (delete-file temp-file))
-
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
--
2.7.0
^ permalink raw reply related [flat|nested] 17+ messages in thread* Re: [PATCH 0/5] Automake custom test driver using SRFI-64.
2016-03-23 23:38 [PATCH 0/5] Automake custom test driver using SRFI-64 Mathieu Lirzin
` (7 preceding siblings ...)
2016-04-01 20:51 ` Ludovic Courtès
@ 2016-04-01 21:45 ` Ludovic Courtès
8 siblings, 0 replies; 17+ messages in thread
From: Ludovic Courtès @ 2016-04-01 21:45 UTC (permalink / raw)
To: Mathieu Lirzin; +Cc: guix-devel
[-- Attachment #1: Type: text/plain, Size: 1114 bytes --]
Mathieu Lirzin <mthl@gnu.org> skribis:
> Mathieu Lirzin (5):
> tests: Silence %cpio-program.
> build: Add a Guile custom test driver using SRFI-64.
> tests: Silence guix-daemon.
> tests: Silence %have-nix-hash?.
> tests: Silence tar.
On closer inspection, this is awesome. :-)
I withdraw my comment about losing some of the “noise” since all we’re
losing is pointless info, and we still have the “useful noise” (like
‘pk’ output) in those nicely structured log files. So I’m happy!
‘make recheck’ still works; it still reruns the whole file (even if only
one test within the file failed), which is surprising but OK and
probably unavoidable given how SRFI-64 works.
The only things I would change is the attached patch: the change to
‘test-env’ removes the “Terminated” messages that Eric mentioned, the
rest improves a docstring in ‘test-driver.scm’ and uses the common
convention for Boolean variables.
If you can integrate something along these lines, then please merge!
I hereby dub you Automake Wizard.
Thank you!
Ludo’.
[-- Attachment #2: Type: text/x-patch, Size: 4562 bytes --]
diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 4439b21..467741f 100644
--- a/build-aux/test-driver.scm
+++ b/build-aux/test-driver.scm
@@ -1,6 +1,6 @@
;;;; test-driver.scm - SRFI-64 custom driver for GNU Automake test suites
-(define script-version "2016-03-28.13") ;UTC
+(define script-version "2016-04-01.21") ;UTC
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
@@ -30,8 +30,7 @@
(srfi srfi-64))
(define (show-help)
- (display "Usage:
- test-driver --test-name=NAME --log-file=PATH --trs-file=PATH
+ (display "Usage: test-driver --test-name=NAME --log-file=PATH --trs-file=PATH
[--expect-failure={yes|no}] [--color-tests={yes|no}]
[--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--]
TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS]
@@ -75,11 +74,11 @@ The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n"))
"[m") ;no color
result)))
-(define* (test-runner-gnu test-name #:key color-tests brief out-port trs-port)
+(define* (test-runner-gnu test-name #:key color? brief? out-port trs-port)
"Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the
-file name of the current the test. COLOR-TESTS and BRIEF are booleans.
-OUT-PORT and TRS-PORT must be output ports. The current output port is
-supposed to be redirected to a '.log' file."
+file name of the current the test. COLOR? specifies whether to use colors,
+and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. The
+current output port is supposed to be redirected to a '.log' file."
(define (test-on-test-begin-gnu runner)
;; Procedure called at the start of an individual test-case, before the
@@ -97,10 +96,10 @@ supposed to be redirected to a '.log' file."
(let* ((results (test-result-alist runner))
(result? (cut assq <> results))
(result (cut assq-ref results <>)))
- (unless brief
+ (unless brief?
;; Display the result of each test case on the console.
(test-display
- (result->string (test-result-kind runner) #:colorize color-tests)
+ (result->string (test-result-kind runner) #:colorize color?)
(string-append test-name " - " (test-runner-test-name runner))
out-port))
(when (result? 'expected-value)
@@ -134,10 +133,10 @@ supposed to be redirected to a '.log' file."
(test-display ":copy-in-global-log"
(if (or fail skip) "yes" "no")
trs-port)
- (when brief
+ (when brief?
;; Display the global test group result on the console.
(test-display (result->string (if fail 'fail (if skip 'skip 'pass))
- #:colorize color-tests)
+ #:colorize color?)
test-name
out-port))
#f))
@@ -167,8 +166,8 @@ supposed to be redirected to a '.log' file."
(setvbuf out _IOLBF)
(test-with-runner
(test-runner-gnu (option 'test-name #f)
- #:color-tests (option->boolean opts 'color-tests)
- #:brief (option->boolean opts 'brief)
+ #:color? (option->boolean opts 'color-tests)
+ #:brief? (option->boolean opts 'brief)
#:out-port out #:trs-port trs)
(parameterize ((current-output-port log)
(current-error-port log)
diff --git a/test-env.in b/test-env.in
index 040175a..2c71d58 100644
--- a/test-env.in
+++ b/test-env.in
@@ -32,6 +32,10 @@ unset CDPATH
if [ -x "@abs_top_builddir@/guix-daemon" ]
then
+ # Silence the daemon's output, which is often useless, as well as that of
+ # Bash (such as "Terminated" messages when 'guix-daemon' is killed.)
+ exec 2> /dev/null
+
NIX_STORE_DIR="@GUIX_TEST_ROOT@/store"
# Do that because store.scm calls `canonicalize-path' on it.
@@ -97,7 +101,7 @@ then
# unavailable, for instance if we're not running as root.
"@abs_top_builddir@/pre-inst-env" \
"@abs_top_builddir@/guix-daemon" --disable-chroot \
- --substitute-urls="$GUIX_BINARY_SUBSTITUTE_URL" 2>/dev/null &
+ --substitute-urls="$GUIX_BINARY_SUBSTITUTE_URL" &
daemon_pid=$!
trap "kill $daemon_pid ; rm -rf $NIX_STATE_DIR" EXIT
^ permalink raw reply related [flat|nested] 17+ messages in thread