Merge branch 'master' into staging

3 files changed, 4 insertions, 119 deletions

diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index f54302cf63..4afdb48903 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
 ;;;
@@ -31,7 +31,7 @@
 
 ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
 ;; port to the bit bucket, let us write to the error port instead.
-(setvbuf (current-error-port) _IOLBF)
+(setvbuf (current-error-port) 'line)
 (set-current-output-port (current-error-port))
 
 (define (find-current-checkout arguments)
diff --git a/build-aux/hydra/guix-modular.scm b/build-aux/hydra/guix-modular.scm
index 9ff9e090fc..8e07e7cd01 100644
--- a/build-aux/hydra/guix-modular.scm
+++ b/build-aux/hydra/guix-modular.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,7 +33,7 @@
 
 ;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
 ;; port to the bit bucket, let us write to the error port instead.
-(setvbuf (current-error-port) _IOLBF)
+(setvbuf (current-error-port) 'line)
 (set-current-output-port (current-error-port))
 
 (define* (build-job store source version system)
diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm
deleted file mode 100644
index b0cb3bd2bf..0000000000
--- a/build-aux/run-system-tests.scm
+++ /dev/null
@@ -1,115 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (run-system-tests)
-  #:use-module (gnu tests)
-  #:use-module (gnu packages package-management)
-  #:use-module ((gnu ci) #:select (channel-instance->package))
-  #:use-module (guix store)
-  #:use-module ((guix status) #:select (with-status-verbosity))
-  #:use-module (guix monads)
-  #:use-module (guix channels)
-  #:use-module (guix derivations)
-  #:use-module ((guix git-download) #:select (git-predicate))
-  #:use-module (guix utils)
-  #:use-module (guix ui)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-34)
-  #:use-module (ice-9 match)
-  #:export (run-system-tests))
-
-(define (built-derivations* drv)
-  (lambda (store)
-    (guard (c ((store-protocol-error? c)
-               (values #f store)))
-      (values (build-derivations store drv) store))))
-
-(define (filterm mproc lst)                       ;XXX: move to (guix monads)
-  (with-monad %store-monad
-    (>>= (foldm %store-monad
-                (lambda (item result)
-                  (mlet %store-monad ((keep? (mproc item)))
-                    (return (if keep?
-                                (cons item result)
-                                result))))
-                '()
-                lst)
-         (lift1 reverse %store-monad))))
-
-(define (tests-for-channel-instance instance)
-  "Return a list of tests for perform, using Guix from INSTANCE, a channel
-instance."
-  ;; Honor the 'TESTS' environment variable so that one can select a subset
-  ;; of tests to run in the usual way:
-  ;;
-  ;;   make check-system TESTS=installed-os
-  (parameterize ((current-guix-package
-                  (channel-instance->package instance)))
-    (match (getenv "TESTS")
-      (#f
-       (all-system-tests))
-      ((= string-tokenize (tests ...))
-       (filter (lambda (test)
-                 (member (system-test-name test) tests))
-               (all-system-tests))))))
-
-
-
-(define (run-system-tests . args)
-  (define source
-    (string-append (current-source-directory) "/.."))
-
-  (with-store store
-    (with-status-verbosity 2
-      (run-with-store store
-        ;; Intern SOURCE so that 'build-from-source' in (guix channels) sees
-        ;; "fresh" file names and thus doesn't find itself loading .go files
-        ;; from ~/.cache/guile when it loads 'build-aux/build-self.scm'.
-        ;; XXX: It would be best to not do it upfront because we may need it.
-        (mlet* %store-monad ((source (interned-file source "guix-source"
-                                                    #:recursive? #t
-                                                    #:select?
-                                                    (or (git-predicate source)
-                                                        (const #t))))
-                             (instance -> (checkout->channel-instance source))
-                             (tests -> (tests-for-channel-instance instance))
-                             (drv (mapm %store-monad system-test-value tests))
-                             (out -> (map derivation->output-path drv)))
-          (format (current-error-port) "Running ~a system tests...~%"
-                  (length tests))
-
-          (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)))))))))