diff options
author | Mathieu Lirzin <mthl@gnu.org> | 2018-03-25 07:29:48 +0200 |
---|---|---|
committer | Mathieu Lirzin <mthl@gnu.org> | 2018-03-25 07:29:48 +0200 |
commit | 596e9e130f38ae068ac6150b2d62eafd544900f6 (patch) | |
tree | b443a409be731f1ca55217e02b2e72741a0a778d /contrib | |
parent | 66c69584f58983e3f61635bbb56bfad1516af87b (diff) | |
download | automake-596e9e130f38ae068ac6150b2d62eafd544900f6.tar.gz |
test-driver.scm: Add "--coverage" option
* contrib/test-driver.scm: When 'coverage' option is enabled, run tests
in the debug vm and trace coverage data.
(%options): Add 'coverage'.
(show-help): Display option.
Diffstat (limited to 'contrib')
-rw-r--r-- | contrib/test-driver.scm | 37 |
1 files changed, 28 insertions, 9 deletions
diff --git a/contrib/test-driver.scm b/contrib/test-driver.scm index 5292c0a0e..e264bea43 100644 --- a/contrib/test-driver.scm +++ b/contrib/test-driver.scm @@ -1,6 +1,6 @@ ;;;; test-driver.scm - Guile test driver for Automake testsuite harness -(define script-version "2018-03-24.22") ;UTC +(define script-version "2018-03-25.05") ;UTC ;;; Copyright © 2015-2018 Free Software Foundation, Inc. ;;; @@ -51,14 +51,18 @@ (use-modules (ice-9 getopt-long) (ice-9 match) (ice-9 pretty-print) + (srfi srfi-11) (srfi srfi-26) - (srfi srfi-64)) + (srfi srfi-64) + (system vm coverage) + (system vm vm)) (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}}] [--] + [--enable-hard-errors={yes|no}] [--brief={yes|no}}] + [--coverage={yes|no}] [--] TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS] The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n")) @@ -69,6 +73,7 @@ The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n")) (color-tests (value #t)) (expect-failure (value #t)) ;XXX: not implemented yet (enable-hard-errors (value #t)) ;not implemented in SRFI-64 + (coverage (value #t)) (brief (value #t)) (help (single-char #\h) (value #f)) (version (single-char #\V) (value #f)))) @@ -188,15 +193,29 @@ current output port is supposed to be redirected to a '.log' file." (let ((log (open-file (option 'log-file "") "w0")) (trs (open-file (option 'trs-file "") "wl")) (out (duplicate-port (current-output-port) "wl"))) + (define (check) + (test-with-runner + (test-runner-gnu (option 'test-name #f) + #:color? (option->boolean opts 'color-tests) + #:brief? (option->boolean opts 'brief) + #:out-port out #:trs-port trs) + (primitive-load script))) + (redirect-port log (current-output-port)) (redirect-port log (current-warning-port)) (redirect-port log (current-error-port)) - (test-with-runner - (test-runner-gnu (option 'test-name #f) - #:color? (option->boolean opts 'color-tests) - #:brief? (option->boolean opts 'brief) - #:out-port out #:trs-port trs) - (primitive-load script)) + + (if (not (option->boolean opts 'coverage)) + (check) + (begin + ;; The debug engine is required for tracing coverage data. + (set-vm-engine! 'debug) + (let-values (((data result) (with-code-coverage check))) + (let* ((file (string-append (option 'test-name #f) ".info")) + (port (open-output-file file))) + (coverage-data->lcov data port) + (close port))))) + (close-port log) (close-port trs) (close-port out)))))) |