nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

build-system/gnu: Dump test suite logs upon 'check' failure. 

Suggested by Mark H Weaver <mhw@netris.org>.

* guix/build/gnu-build-system.scm (dump-file-contents): New procedure.
(%test-suite-log-regexp): New variable.
(check): Add #:test-suite-log-regexp.  Catch 'invoke-error?' and call
'dump-file-contents' upon error.
This commit is contained in:
Ludovic Courtès 2018-03-19 10:50:05 +01:00
parent 4735610ee3
commit 88b87c352f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 35 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
guix/build/gnu-build-system.scm
View File

@ -33,6 +33,7 @@
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:export (%standard-phases #:export (%standard-phases
%license-file-regexp %license-file-regexp
dump-file-contents
gnu-build)) gnu-build))
;; Commentary: ;; Commentary:
@ -335,15 +336,44 @@ makefiles."
'()) '())
,@make-flags))) ,@make-flags)))
(define* (dump-file-contents directory file-regexp
#:optional (port (current-error-port)))
"Dump to PORT the contents of files in DIRECTORY that match FILE-REGEXP."
(define (dump file)
(let ((prefix (string-append "\n--- " file " ")))
(display (if (< (string-length prefix) 78)
(string-pad-right prefix 78 #\---)
prefix)
port)
(display "\n\n" port)
(call-with-input-file file
(lambda (log)
(dump-port log port)))
(display "\n" port)))
(for-each dump (find-files directory file-regexp)))
(define %test-suite-log-regexp
;; Name of test suite log files as commonly found in GNU-based build systems
;; and CMake.
"^(test-?suite\\.log|LastTestFailed\\.log)$")
(define* (check #:key target (make-flags '()) (tests? (not target)) (define* (check #:key target (make-flags '()) (tests? (not target))
(test-target "check") (parallel-tests? #t) (test-target "check") (parallel-tests? #t)
(test-suite-log-regexp %test-suite-log-regexp)
#:allow-other-keys) #:allow-other-keys)
(if tests? (if tests?
(apply invoke "make" test-target (guard (c ((invoke-error? c)
`(,@(if parallel-tests? ;; Dump the test suite log to facilitate debugging.
`("-j" ,(number->string (parallel-job-count))) (display "\nTest suite failed, dumping logs.\n"
'()) (current-error-port))
,@make-flags)) (dump-file-contents "." test-suite-log-regexp)
(raise c)))
(apply invoke "make" test-target
`(,@(if parallel-tests?
`("-j" ,(number->string (parallel-job-count)))
'())
,@make-flags)))
(format #t "test suite not run~%")) (format #t "test suite not run~%"))
#t) #t)