me
/
guix
Archived
1
0
Fork 0
Code

tests: "make check-system" produces colored output. 

* build-aux/run-system-tests.scm (run-system-tests): Use 'with-status-report'.
master
Ludovic Courtès 2018-10-09 09:24:24 +02:00
parent 1fe57b3746
commit 276f368051
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 26 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
build-aux/run-system-tests.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,6 +19,7 @@
(define-module (run-system-tests) (define-module (run-system-tests)
#:use-module (gnu tests) #:use-module (gnu tests)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix status)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix ui) #:use-module (guix ui)
@ -63,25 +64,27 @@
(length tests)) (length tests))
(with-store store (with-store store
(run-with-store store (with-status-report print-build-event
(mlet* %store-monad ((drv (mapm %store-monad system-test-value tests)) (run-with-store store
(out -> (map derivation->output-path drv))) (mlet* %store-monad ((drv (mapm %store-monad system-test-value tests))
(mbegin %store-monad (out -> (map derivation->output-path drv)))
(show-what-to-build* drv) (mbegin %store-monad
(set-build-options* #:keep-going? #t #:keep-failed? #t (show-what-to-build* drv)
#:print-build-trace #t (set-build-options* #:keep-going? #t #:keep-failed? #t
#:fallback? #t) #:print-build-trace #t
(built-derivations* drv) #:print-extended-build-trace? #t
(mlet %store-monad ((valid (filterm (store-lift valid-path?) #:fallback? #t)
out)) (built-derivations* drv)
(failed (filterm (store-lift (mlet %store-monad ((valid (filterm (store-lift valid-path?)
(negate valid-path?)) out))
out))) (failed (filterm (store-lift
(format #t "TOTAL: ~a\n" (length drv)) (negate valid-path?))
(for-each (lambda (item) out)))
(format #t "PASS: ~a~%" item)) (format #t "TOTAL: ~a\n" (length drv))
valid) (for-each (lambda (item)
(for-each (lambda (item) (format #t "PASS: ~a~%" item))
(format #t "FAIL: ~a~%" item)) valid)
failed) (for-each (lambda (item)
(exit (null? failed)))))))) (format #t "FAIL: ~a~%" item))
failed)
(exit (null? failed)))))))))