From 276f368051ff52cf202ede9fce579e49d9d744ec Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 9 Oct 2018 09:24:24 +0200
Subject: tests: "make check-system" produces colored output.

* build-aux/run-system-tests.scm (run-system-tests): Use 'with-status-report'.
---
 build-aux/run-system-tests.scm | 49 ++++++++++++++++++++++--------------------
 1 file changed, 26 insertions(+), 23 deletions(-)

(limited to 'build-aux')

diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm
index 8b44f579a2..953ba3e221 100644
--- a/build-aux/run-system-tests.scm
+++ b/build-aux/run-system-tests.scm
@@ -1,5 +1,5 @@
 ;;; 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.
 ;;;
@@ -19,6 +19,7 @@
 (define-module (run-system-tests)
   #:use-module (gnu tests)
   #:use-module (guix store)
+  #:use-module (guix status)
   #:use-module (guix monads)
   #:use-module (guix derivations)
   #:use-module (guix ui)
@@ -63,25 +64,27 @@
           (length tests))
 
   (with-store store
-    (run-with-store store
-      (mlet* %store-monad ((drv (mapm %store-monad system-test-value tests))
-                           (out -> (map derivation->output-path drv)))
-        (mbegin %store-monad
-          (show-what-to-build* drv)
-          (set-build-options* #:keep-going? #t #:keep-failed? #t
-                              #:print-build-trace #t
-                              #:fallback? #t)
-          (built-derivations* drv)
-          (mlet %store-monad ((valid  (filterm (store-lift valid-path?)
-                                               out))
-                              (failed (filterm (store-lift
-                                                (negate valid-path?))
-                                               out)))
-            (format #t "TOTAL: ~a\n" (length drv))
-            (for-each (lambda (item)
-                        (format #t "PASS: ~a~%" item))
-                      valid)
-            (for-each (lambda (item)
-                        (format #t "FAIL: ~a~%" item))
-                      failed)
-            (exit (null? failed))))))))
+    (with-status-report print-build-event
+      (run-with-store store
+        (mlet* %store-monad ((drv (mapm %store-monad system-test-value tests))
+                             (out -> (map derivation->output-path drv)))
+          (mbegin %store-monad
+            (show-what-to-build* drv)
+            (set-build-options* #:keep-going? #t #:keep-failed? #t
+                                #:print-build-trace #t
+                                #:print-extended-build-trace? #t
+                                #:fallback? #t)
+            (built-derivations* drv)
+            (mlet %store-monad ((valid  (filterm (store-lift valid-path?)
+                                                 out))
+                                (failed (filterm (store-lift
+                                                  (negate valid-path?))
+                                                 out)))
+              (format #t "TOTAL: ~a\n" (length drv))
+              (for-each (lambda (item)
+                          (format #t "PASS: ~a~%" item))
+                        valid)
+              (for-each (lambda (item)
+                          (format #t "FAIL: ~a~%" item))
+                        failed)
+              (exit (null? failed)))))))))
-- 
cgit v1.2.3