Browse Source

build: Add 'run-system-tests.scm'.

This file was meant to be added as part of
commit e9f693d06f.

* build-aux/run-system-tests.scm: New file.
* Makefile.am (EXTRA_DIST): Add it.
gn-latest-20200428
Ludovic Courtès 5 years ago
parent
commit
41c569d9b9
No known key found for this signature in database GPG Key ID: 90B11993D9AEBB5
2 changed files with 72 additions and 0 deletions
  1. +1
    -0
      Makefile.am
  2. +71
    -0
      build-aux/run-system-tests.scm

+ 1
- 0
Makefile.am View File

@ -361,6 +361,7 @@ EXTRA_DIST = \
build-aux/make-binary-tarball.scm \
build-aux/generate-authors.scm \
build-aux/test-driver.scm \
build-aux/run-system-tests.scm \
srfi/srfi-37.scm.in \
srfi/srfi-64.scm \
srfi/srfi-64.upstream.scm \


+ 71
- 0
build-aux/run-system-tests.scm View File

@ -0,0 +1,71 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 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 base)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix ui)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:export (run-system-tests))
(define (built-derivations* drv)
(lambda (store)
(guard (c ((nix-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 %system-tests
(list %test-basic-os))
(define (run-system-tests . args)
(with-store store
(run-with-store store
(mlet* %store-monad ((drv (sequence %store-monad %system-tests))
(out -> (map derivation->output-path drv)))
(mbegin %store-monad
(show-what-to-build* drv)
(set-build-options* #:keep-going? #t #:keep-failed? #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))))))))

Loading…
Cancel
Save