From dd1ee160be8ba4e211432c08e161c24901cd670e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Mar 2020 12:35:46 +0100 Subject: tests: "make check-system" no longer interns source upfront. * gnu/ci.scm (channel-build-system)[build, lower]: Honor #:source. (channel-source->package): New procedure. (system-test-jobs): Remove 'instance' and call to 'checkout->channel-instance'. Use 'channel-source->package'. * build-aux/run-system-tests.scm (tests-for-channel-instance): Rename to... (tests-for-current-guix): ... this. Change 'instance' to 'source'. (run-system-tests): Use 'local-file' instead of 'interned-file' for SOURCE. --- build-aux/run-system-tests.scm | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) (limited to 'build-aux') diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm index b0cb3bd2bf..a4c019ab0b 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, 2018, 2019 Ludovic Courtès +;;; Copyright © 2016, 2018, 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +19,8 @@ (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 ((gnu ci) #:select (channel-source->package)) + #:use-module (guix gexp) #:use-module (guix store) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix monads) @@ -51,15 +52,15 @@ lst) (lift1 reverse %store-monad)))) -(define (tests-for-channel-instance instance) - "Return a list of tests for perform, using Guix from INSTANCE, a channel +(define (tests-for-current-guix source) + "Return a list of tests for perform, using Guix built from SOURCE, 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))) + (channel-source->package source))) (match (getenv "TESTS") (#f (all-system-tests)) @@ -80,14 +81,12 @@ instance." ;; 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" + (mlet* %store-monad ((source -> (local-file source "guix-source" #:recursive? #t #:select? (or (git-predicate source) (const #t)))) - (instance -> (checkout->channel-instance source)) - (tests -> (tests-for-channel-instance instance)) + (tests -> (tests-for-current-guix source)) (drv (mapm %store-monad system-test-value tests)) (out -> (map derivation->output-path drv))) (format (current-error-port) "Running ~a system tests...~%" -- cgit v1.2.3 From c5a3d8f6469f9fb4d47e2d4c84980ab04aedb398 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 5 Mar 2020 14:54:17 +0100 Subject: tests: "make check-system" includes the current commit ID, if any. * build-aux/run-system-tests.scm (source-commit): New procedure. (tests-for-current-guix): Add 'commit' parameter and pass it to 'channel-source->package'. (run-system-tests): Call 'source-commit' and pass the result to 'tests-for-current-guix'. --- build-aux/run-system-tests.scm | 31 ++++++++++++++++++++++++++----- 1 file changed, 26 insertions(+), 5 deletions(-) (limited to 'build-aux') diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm index a4c019ab0b..b5403e0ece 100644 --- a/build-aux/run-system-tests.scm +++ b/build-aux/run-system-tests.scm @@ -29,6 +29,7 @@ #:use-module ((guix git-download) #:select (git-predicate)) #:use-module (guix utils) #:use-module (guix ui) + #:use-module (git) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (ice-9 match) @@ -52,7 +53,24 @@ lst) (lift1 reverse %store-monad)))) -(define (tests-for-current-guix source) +(define (source-commit directory) + "Return the commit of the head of DIRECTORY or #f if it could not be +determined." + (let ((repository #f)) + (catch 'git-error + (lambda () + (set! repository (repository-open directory)) + (let* ((head (repository-head repository)) + (target (reference-target head)) + (commit (oid->string target))) + (repository-close! repository) + commit)) + (lambda _ + (when repository + (repository-close! repository)) + #f)))) + +(define (tests-for-current-guix source commit) "Return a list of tests for perform, using Guix built from SOURCE, a channel instance." ;; Honor the 'TESTS' environment variable so that one can select a subset @@ -60,7 +78,7 @@ instance." ;; ;; make check-system TESTS=installed-os (parameterize ((current-guix-package - (channel-source->package source))) + (channel-source->package source #:commit commit))) (match (getenv "TESTS") (#f (all-system-tests)) @@ -69,12 +87,15 @@ instance." (member (system-test-name test) tests)) (all-system-tests)))))) - - (define (run-system-tests . args) (define source (string-append (current-source-directory) "/..")) + (define commit + ;; Fetch the current commit ID so we can potentially build the same + ;; derivation as ci.guix.gnu.org. + (source-commit source)) + (with-store store (with-status-verbosity 2 (run-with-store store @@ -86,7 +107,7 @@ instance." #:select? (or (git-predicate source) (const #t)))) - (tests -> (tests-for-current-guix source)) + (tests -> (tests-for-current-guix source commit)) (drv (mapm %store-monad system-test-value tests)) (out -> (map derivation->output-path drv))) (format (current-error-port) "Running ~a system tests...~%" -- cgit v1.2.3 From 5ec4156bbcaec8337f78411204d59e59e706103b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 5 Mar 2020 16:16:02 +0100 Subject: tests: Add a manifest for system tests. The manifest can be passed to 'guix build -m', 'guix weather -m', and so on. It can also be passed to an installed 'guix' (without ./pre-inst-env), with the exception so far of installation tests. * build-aux/run-system-tests.scm: Remove. Move interesting bits move to... * etc/system-tests.scm: ... here. New file. * Makefile.am (EXTRA_DIST): Remove 'build-aux/run-system-tests.scm' and add 'etc/system-tests.scm'. (check-system): Rewrite to run 'guix build -m etc/system-tests.scm'. --- Makefile.am | 8 +-- build-aux/run-system-tests.scm | 135 ----------------------------------------- etc/system-tests.scm | 94 ++++++++++++++++++++++++++++ 3 files changed, 97 insertions(+), 140 deletions(-) delete mode 100644 build-aux/run-system-tests.scm create mode 100644 etc/system-tests.scm (limited to 'build-aux') diff --git a/Makefile.am b/Makefile.am index e18c17d8b3..3b951be7f5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès # Copyright © 2013 Andreas Enge # Copyright © 2015, 2017 Alex Kost # Copyright © 2016, 2018 Mathieu Lirzin @@ -510,9 +510,7 @@ endif !CAN_RUN_TESTS check-system: $(GOBJECTS) $(AM_V_at)$(top_builddir)/pre-inst-env \ - $(GUILE) --no-auto-compile \ - -e '(@@ (run-system-tests) run-system-tests)' \ - $(top_srcdir)/build-aux/run-system-tests.scm + guix build -m $(top_srcdir)/etc/system-tests.scm -K # Public keys used to sign substitutes. dist_pkgdata_DATA = \ @@ -543,6 +541,7 @@ EXTRA_DIST += \ scripts/guix.in \ etc/guix-install.sh \ etc/news.scm \ + etc/system-tests.scm \ build-aux/build-self.scm \ build-aux/compile-all.scm \ build-aux/hydra/evaluate.scm \ @@ -560,7 +559,6 @@ EXTRA_DIST += \ build-aux/test-driver.scm \ build-aux/update-guix-package.scm \ build-aux/update-NEWS.scm \ - build-aux/run-system-tests.scm \ d3.v3.js \ graph.js \ tests/test.drv \ diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm deleted file mode 100644 index b5403e0ece..0000000000 --- a/build-aux/run-system-tests.scm +++ /dev/null @@ -1,135 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2018, 2019, 2020 Ludovic Courtès -;;; -;;; 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 . - -(define-module (run-system-tests) - #:use-module (gnu tests) - #:use-module (gnu packages package-management) - #:use-module ((gnu ci) #:select (channel-source->package)) - #:use-module (guix gexp) - #: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 (git) - #: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 (source-commit directory) - "Return the commit of the head of DIRECTORY or #f if it could not be -determined." - (let ((repository #f)) - (catch 'git-error - (lambda () - (set! repository (repository-open directory)) - (let* ((head (repository-head repository)) - (target (reference-target head)) - (commit (oid->string target))) - (repository-close! repository) - commit)) - (lambda _ - (when repository - (repository-close! repository)) - #f)))) - -(define (tests-for-current-guix source commit) - "Return a list of tests for perform, using Guix built from SOURCE, 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-source->package source #:commit commit))) - (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) "/..")) - - (define commit - ;; Fetch the current commit ID so we can potentially build the same - ;; derivation as ci.guix.gnu.org. - (source-commit source)) - - (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'. - (mlet* %store-monad ((source -> (local-file source "guix-source" - #:recursive? #t - #:select? - (or (git-predicate source) - (const #t)))) - (tests -> (tests-for-current-guix source commit)) - (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))))))))) diff --git a/etc/system-tests.scm b/etc/system-tests.scm new file mode 100644 index 0000000000..ab2827e70a --- /dev/null +++ b/etc/system-tests.scm @@ -0,0 +1,94 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016, 2018, 2019, 2020 Ludovic Courtès +;;; +;;; 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 . + +(use-modules (gnu tests) + (gnu packages package-management) + ((gnu ci) #:select (channel-source->package)) + ((guix git-download) #:select (git-predicate)) + ((guix utils) #:select (current-source-directory)) + (git) + (ice-9 match)) + +(define (source-commit directory) + "Return the commit of the head of DIRECTORY or #f if it could not be +determined." + (let ((repository #f)) + (catch 'git-error + (lambda () + (set! repository (repository-open directory)) + (let* ((head (repository-head repository)) + (target (reference-target head)) + (commit (oid->string target))) + (repository-close! repository) + commit)) + (lambda _ + (when repository + (repository-close! repository)) + #f)))) + +(define (tests-for-current-guix source commit) + "Return a list of tests for perform, using Guix built from SOURCE, 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-source->package source #:commit commit))) + (match (getenv "TESTS") + (#f + (all-system-tests)) + ((= string-tokenize (tests ...)) + (filter (lambda (test) + (member (system-test-name test) tests)) + (all-system-tests)))))) + +(define (system-test->manifest-entry test) + "Return a manifest entry for TEST, a system test." + (manifest-entry + (name (string-append "test." (system-test-name test))) + (version "0") + (item test))) + +(define (system-test-manifest) + "Return a manifest containing all the system tests, or all those selected by +the 'TESTS' environment variable." + (define source + (string-append (current-source-directory) "/..")) + + (define commit + ;; Fetch the current commit ID so we can potentially build the same + ;; derivation as ci.guix.gnu.org. + (source-commit source)) + + ;; 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'. + (let* ((source (local-file source "guix-source" + #:recursive? #t + #:select? + (or (git-predicate source) + (const #t)))) + (tests (tests-for-current-guix source commit))) + (format (current-error-port) "Selected ~a system tests...~%" + (length tests)) + + (manifest (map system-test->manifest-entry tests)))) + +;; Return the manifest. +(system-test-manifest) -- cgit v1.2.3 From 530e31b82448ba00dbbe6abc078204d340c09cb1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 5 Mar 2020 23:21:37 +0100 Subject: hydra: Remove uses of _IOLBF. _IOLBF & co. were deprecated in Guile 2.2 and removed in 3.0. * build-aux/hydra/gnu-system.scm: Pass 'line instead of _IOLBF to 'setvbuf'. * build-aux/hydra/guix-modular.scm: Likewise. --- build-aux/hydra/gnu-system.scm | 4 ++-- build-aux/hydra/guix-modular.scm | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'build-aux') 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 +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès ;;; Copyright © 2017 Jan Nieuwenhuizen ;;; Copyright © 2018, 2019 Clément Lassieur ;;; @@ -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 +;;; Copyright © 2017, 2018, 2020 Ludovic Courtès ;;; ;;; 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) -- cgit v1.2.3