aboutsummaryrefslogtreecommitdiff
path: root/build-aux/test-driver.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-03-22 14:59:24 +0100
committerLudovic Courtès <ludo@gnu.org>2017-03-22 15:02:33 +0100
commit73a46451af333c77d2e79aa8764f51be8c34d1ae (patch)
tree7a5ed0345d51283a3d9e426350a06801b28130e1 /build-aux/test-driver.scm
parent50b4d3ac2699764079882eea164cb176a74799aa (diff)
downloadguix-73a46451af333c77d2e79aa8764f51be8c34d1ae.tar
guix-73a46451af333c77d2e79aa8764f51be8c34d1ae.tar.gz
build: 'test-driver.scm' prints Scheme values with 'write'.
Previously it would print them with 'display', which was inconvenient. * build-aux/test-driver.scm (test-display): Use ~S for VALUE. (test-runner-gnu): Use 'format' instead of 'test-display' for the test name, location, and result kind.
Diffstat (limited to 'build-aux/test-driver.scm')
-rw-r--r--build-aux/test-driver.scm51
1 files changed, 23 insertions, 28 deletions
diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index e9cc2cb24c..52af1e9be7 100644
--- a/build-aux/test-driver.scm
+++ b/build-aux/test-driver.scm
@@ -1,6 +1,6 @@
;;;; test-driver.scm - Guile test driver for Automake testsuite harness
-(define script-version "2016-04-03.12") ;UTC
+(define script-version "2017-03-22.13") ;UTC
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
@@ -59,7 +59,7 @@ The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n"))
(begin
(format port "~A:~%" field)
(pretty-print value port #:per-line-prefix "+ "))
- (format port "~A: ~A~%" field value)))
+ (format port "~A: ~S~%" field value)))
(define* (result->string symbol #:key colorize?)
"Return SYMBOL as an upper case string. Use colors when COLORIZE is #t."
@@ -85,10 +85,10 @@ current output port is supposed to be redirected to a '.log' file."
;; 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))))
+ (format #t "test-name: ~A~%" (result 'test-name))
+ (format #t "location: ~A~%"
+ (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)
@@ -99,10 +99,9 @@ current output port is supposed to be redirected to a '.log' file."
(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?)
- (string-append test-name " - " (test-runner-test-name runner))
- out-port))
+ (format out-port "~A: ~A - ~A~%"
+ (result->string (test-result-kind runner) #:colorize? color?)
+ test-name (test-runner-test-name runner)))
(when (result? 'expected-value)
(test-display "expected-value" (result 'expected-value)))
(when (result? 'expected-error)
@@ -111,12 +110,11 @@ current output port is supposed to be redirected to a '.log' file."
(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)))
+ (format #t "result: ~a~%" (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)))
+ (format trs-port ":test-result: ~A ~A~%"
+ (result->string (test-result-kind runner))
+ (test-runner-test-name runner))))
(define (test-on-group-end-gnu runner)
;; Procedure called by a 'test-end', including at the end of a test-group.
@@ -125,21 +123,18 @@ current output port is supposed to be redirected to a '.log' file."
(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)
+ (format trs-port ":global-test-result: ~A~%"
+ (if fail "FAIL" (if skip "SKIP" "PASS")))
+ (format trs-port ":recheck: ~A~%"
+ (if fail "yes" "no"))
+ (format trs-port ":copy-in-global-log: ~A~%"
+ (if (or fail skip) "yes" "no"))
(when brief?
;; Display the global test group result on the console.
- (test-display (result->string (if fail 'fail (if skip 'skip 'pass))
- #:colorize? color?)
- test-name
- out-port))
+ (format out-port "~A: ~A~%"
+ (result->string (if fail 'fail (if skip 'skip 'pass))
+ #:colorize? color?)
+ test-name))
#f))
(let ((runner (test-runner-null)))