From 1fb75128a5202b406622da6272bc809c46d1f439 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 25 Sep 2021 18:36:04 +0200 Subject: [PATCH] tests: Adjust to SRFI-64 as found in Guile 3.0.7. In Guile 3.0.7, 'test-runner-current' is set to #f upon 'test-end'. Consequently, the previous strategy, where we'd call 'test-runner-current' after 'test-end', no longer works. Instead, set the test runner in each test right before 'test-begin'. * gnu/build/marionette.scm (system-test-runner): New procedure. * gnu/tests/audio.scm (run-mpd-test): Replace (exit (= ...)) idiom by (test-runner-current (system-test-runner)). * gnu/tests/base.scm (run-basic-test) (run-cleanup-test, run-mcron-test, run-nss-mdns-test): Likewise. * gnu/tests/ci.scm (run-laminar-test): Likewise. * gnu/tests/cups.scm (run-cups-test): Likewise. * gnu/tests/databases.scm (run-memcached-test) (run-postgresql-test, run-mysql-test): Likewise. * gnu/tests/desktop.scm (run-elogind-test): Likewise. * gnu/tests/dict.scm (run-dicod-test): Likewise. * gnu/tests/docker.scm (run-docker-test): Likewise. (run-docker-system-test): Likewise. * gnu/tests/file-sharing.scm (run-transmission-daemon-test): Likewise. * gnu/tests/ganeti.scm (run-ganeti-test): Likewise. * gnu/tests/guix.scm (run-guix-build-coordinator-test): Likewise. (run-guix-data-service-test): Likewise. * gnu/tests/ldap.scm (run-ldap-test): Likewise. * gnu/tests/linux-modules.scm (run-loadable-kernel-modules-test-base): Likewise. * gnu/tests/mail.scm (run-opensmtpd-test) (run-exim-test, run-dovecot-test, run-getmail-test): Likewise. * gnu/tests/messaging.scm (run-xmpp-test) (run-bitlbee-test, run-quassel-test): Likewise. * gnu/tests/monitoring.scm (run-prometheus-node-exporter-server-test) (run-zabbix-server-test): Likewise. * gnu/tests/networking.scm (run-inetd-test, run-openvswitch-test) (run-dhcpd-test, run-tor-test, run-iptables-test, run-ipfs-test): Likewise. * gnu/tests/nfs.scm (run-nfs-test) (run-nfs-server-test, run-nfs-root-fs-test): Likewise. * gnu/tests/package-management.scm (run-nix-test): Likewise. * gnu/tests/reconfigure.scm (run-switch-to-system-test) (run-upgrade-services-test, run-install-bootloader-test): Likewise. * gnu/tests/rsync.scm (run-rsync-test): Likewise. * gnu/tests/security-token.scm (run-pcscd-test): Likewise. * gnu/tests/singularity.scm (run-singularity-test): Likewise. * gnu/tests/ssh.scm (run-ssh-test): Likewise. * gnu/tests/telephony.scm (run-jami-test): Likewise. * gnu/tests/version-control.scm (run-cgit-test): Likewise. (run-git-http-test, run-gitolite-test, run-gitile-test): Likewise. * gnu/tests/virtualization.scm (run-libvirt-test, run-childhurd-test): Likewise. * gnu/tests/web.scm (run-webserver-test, run-php-fpm-test) (run-hpcguix-web-server-test, run-tailon-test, run-patchwork-test): Likewise. --- gnu/build/marionette.scm | 24 ++++++++++++++++++++++-- gnu/tests/audio.scm | 4 ++-- gnu/tests/base.scm | 16 ++++++++-------- gnu/tests/ci.scm | 6 +++--- gnu/tests/cups.scm | 4 ++-- gnu/tests/databases.scm | 12 ++++++------ gnu/tests/desktop.scm | 6 +++--- gnu/tests/dict.scm | 6 +++--- gnu/tests/docker.scm | 8 ++++---- gnu/tests/file-sharing.scm | 4 ++-- gnu/tests/ganeti.scm | 4 ++-- gnu/tests/guix.scm | 8 ++++---- gnu/tests/ldap.scm | 4 ++-- gnu/tests/linux-modules.scm | 10 ++++++++-- gnu/tests/mail.scm | 18 +++++++++--------- gnu/tests/messaging.scm | 14 +++++++------- gnu/tests/monitoring.scm | 9 ++++----- gnu/tests/networking.scm | 24 ++++++++++++------------ gnu/tests/nfs.scm | 14 +++++++------- gnu/tests/package-management.scm | 5 ++--- gnu/tests/reconfigure.scm | 12 ++++++------ gnu/tests/rsync.scm | 4 ++-- gnu/tests/security-token.scm | 4 ++-- gnu/tests/singularity.scm | 6 +++--- gnu/tests/ssh.scm | 6 +++--- gnu/tests/telephony.scm | 4 ++-- gnu/tests/version-control.scm | 18 +++++++++--------- gnu/tests/virtualization.scm | 10 +++++----- gnu/tests/web.scm | 23 +++++++++++------------ 29 files changed, 155 insertions(+), 132 deletions(-) diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm index fe754cd147..941461a72c 100644 --- a/gnu/build/marionette.scm +++ b/gnu/build/marionette.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2018 Chris Marusich ;;; ;;; This file is part of GNU Guix. @@ -20,6 +20,7 @@ (define-module (gnu build marionette) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (ice-9 match) #:use-module (ice-9 popen) @@ -33,7 +34,9 @@ marionette-screen-text wait-for-screen-text %qwerty-us-keystrokes - marionette-type)) + marionette-type + + system-test-runner)) ;;; Commentary: ;;; @@ -358,4 +361,21 @@ to actual keystrokes." (for-each (cut marionette-control <> marionette) (string->keystroke-commands str keystrokes))) + +;;; +;;; Test helper. +;;; + +(define (system-test-runner) + "Return a SRFI-64 test runner that calls 'exit' upon 'test-end'." + (let ((runner (test-runner-simple))) + ;; On 'test-end', display test results and exit with zero if and only if + ;; there were no test failures. + (test-runner-on-final! runner + (lambda (runner) + (let ((success? (= (test-runner-fail-count runner) 0))) + (test-on-final-simple runner) + (exit success?)))) + runner)) + ;;; marionette.scm ends here diff --git a/gnu/tests/audio.scm b/gnu/tests/audio.scm index 7bf7d4ef14..0124fa36a0 100644 --- a/gnu/tests/audio.scm +++ b/gnu/tests/audio.scm @@ -51,6 +51,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "mpd") (test-assert "service is running" @@ -70,8 +71,7 @@ '(system* #$(file-append mpd-mpc "/bin/mpc")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "mpd-test" test)) (define %test-mpd diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 9429a10b75..81be8de1cf 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -97,6 +97,7 @@ Otherwise assume that there is no password for root." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "basic") #$(and initialization @@ -505,8 +506,7 @@ info --version") "root@" #$(operating-system-host-name os)))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation name test)) @@ -645,6 +645,7 @@ in a loop. See .") (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "cleanup") (test-assert "dirty service worked" @@ -657,8 +658,7 @@ in a loop. See .") (scandir "/tmp")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "cleanup" test)) @@ -716,6 +716,7 @@ non-ASCII names from /tmp.") (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "mcron") (test-assert "service running" @@ -752,8 +753,7 @@ non-ASCII names from /tmp.") result) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation name test)) @@ -824,6 +824,7 @@ non-ASCII names from /tmp.") (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "avahi") (test-assert "nscd PID file is created" @@ -902,8 +903,7 @@ non-ASCII names from /tmp.") (= (hostent:addrtype result) AF_INET))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "nss-mdns" test)) diff --git a/gnu/tests/ci.scm b/gnu/tests/ci.scm index a8b39fcd01..b7970017fc 100644 --- a/gnu/tests/ci.scm +++ b/gnu/tests/ci.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès +;;; Copyright © 2017, 2021 Ludovic Courtès ;;; Copyright © 2017, 2018, 2019, 2020, 2021 Christopher Baines ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2018 Pierre-Antoine Rouby @@ -73,6 +73,7 @@ HTTP-PORT." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "laminar") (test-assert "service running" @@ -116,8 +117,7 @@ HTTP-PORT." #:times 10 #:delay 5)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "laminar-test" test)) diff --git a/gnu/tests/cups.scm b/gnu/tests/cups.scm index 4e922e5023..fd6d87d2bf 100644 --- a/gnu/tests/cups.scm +++ b/gnu/tests/cups.scm @@ -57,6 +57,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "cups") ;; Wait for the web interface to become ready. @@ -80,8 +81,7 @@ #:decode-body? #t))) (response-code response))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "cups-test" test)) diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm index c8d11e10c0..ba2bb182b9 100644 --- a/gnu/tests/databases.scm +++ b/gnu/tests/databases.scm @@ -64,6 +64,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "memcached") ;; Wait for memcached to be up and running. @@ -115,8 +116,7 @@ '(file-exists? "/var/log/memcached") marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "memcached-test" test)) @@ -182,6 +182,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "postgresql") (test-assert "service running" @@ -241,8 +242,7 @@ (string-contains output "1"))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "postgresql-test" test)) @@ -286,6 +286,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "mysql") (test-assert "service running" @@ -341,8 +342,7 @@ output)) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "mysql-test" test)) diff --git a/gnu/tests/desktop.scm b/gnu/tests/desktop.scm index 6aa22fd49b..67e530d392 100644 --- a/gnu/tests/desktop.scm +++ b/gnu/tests/desktop.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès +;;; Copyright © 2017, 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -46,6 +46,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "elogind") ;; Log in as root on tty1, and check what 'loginctl' returns. @@ -83,8 +84,7 @@ (guest-file "/root/seats") (guest-file "/root/users"))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "elogind" test)) diff --git a/gnu/tests/dict.scm b/gnu/tests/dict.scm index c50e3cd6da..51343be7de 100644 --- a/gnu/tests/dict.scm +++ b/gnu/tests/dict.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018 Ludovic Courtès +;;; Copyright © 2017, 2018, 2021 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; ;;; This file is part of GNU Guix. @@ -82,6 +82,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "dicod") ;; Wait for the service to be started. @@ -117,8 +118,7 @@ (string-contains result "hello") result)))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "dicod" test)) diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 92611b0a8d..45b5d375ea 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -79,6 +79,7 @@ inside %DOCKER-OS." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "docker") (test-assert "service running" @@ -143,8 +144,7 @@ inside %DOCKER-OS." (string->number response4)))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "docker-test" test)) @@ -224,6 +224,7 @@ inside %DOCKER-OS." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "docker") (test-assert "service running" @@ -288,8 +289,7 @@ inside %DOCKER-OS." "status" "guix-daemon"))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "docker-system-test" test)) diff --git a/gnu/tests/file-sharing.scm b/gnu/tests/file-sharing.scm index 9a8ee6a593..7dd2a847f0 100644 --- a/gnu/tests/file-sharing.scm +++ b/gnu/tests/file-sharing.scm @@ -94,6 +94,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "transmission-daemon") ;; Make sure the "transmission" user and group have been created. @@ -259,8 +260,7 @@ "--auth" auth-string "--session-info")))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "transmission-daemon-test" test)) diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm index b64a332dde..be70d1117a 100644 --- a/gnu/tests/ganeti.scm +++ b/gnu/tests/ganeti.scm @@ -120,6 +120,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "ganeti") ;; Ganeti uses the Shepherd to start/stop daemons, so make sure @@ -248,8 +249,7 @@ "destroy" "--yes-do-it")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 1))))) + (test-end)))) (gexp->derivation (string-append "ganeti-" hypervisor "-test") test)) diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm index af7d8f0b21..7e3bc8c1f5 100644 --- a/gnu/tests/guix.scm +++ b/gnu/tests/guix.scm @@ -77,6 +77,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "guix-build-coordinator") (test-assert "service running" @@ -99,8 +100,7 @@ #:decode-body? #t))) (response-code response))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "guix-build-coordinator-test" test)) @@ -202,6 +202,7 @@ host all all ::1/128 trust")))))) (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "guix-data-service") (test-assert "service running" @@ -235,8 +236,7 @@ host all all ::1/128 trust")))))) #:decode-body? #t))) (response-code response))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "guix-data-service-test" test)) diff --git a/gnu/tests/ldap.scm b/gnu/tests/ldap.scm index 197c1bfb28..e149972027 100644 --- a/gnu/tests/ldap.scm +++ b/gnu/tests/ldap.scm @@ -72,6 +72,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "ldap") ;; Set up LDAP directory server @@ -148,8 +149,7 @@ suffix = dc=example,dc=com"))) #$(file-append coreutils "/bin/true"))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "ldap-test" test)) diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm index fc8945b77f..200c151008 100644 --- a/gnu/tests/linux-modules.scm +++ b/gnu/tests/linux-modules.scm @@ -76,23 +76,29 @@ that MODULES are actually loaded." (marionette-operating-system base-os #:imported-modules '((guix combinators)))) + (define vm (virtual-machine os)) + (define (test script) (with-imported-modules '((gnu build marionette)) #~(begin (use-modules (gnu build marionette) (srfi srfi-64)) + (define marionette (make-marionette (list #$vm))) + (mkdir #$output) (chdir #$output) + + (test-runner-current (system-test-runner)) (test-begin "loadable-kernel-modules") (test-assert "script successfully evaluated" (marionette-eval '(primitive-load #$script) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) + (gexp->derivation "loadable-kernel-modules" (test (modules-loaded?-program os module-names)))) diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm index eb8952b33a..ae6417c119 100644 --- a/gnu/tests/mail.scm +++ b/gnu/tests/mail.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Sou Bunnbu ;;; Copyright © 2017 Carlo Zancanaro -;;; Copyright © 2017, 2020 Ludovic Courtès +;;; Copyright © 2017, 2020, 2021 Ludovic Courtès ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2018 Clément Lassieur ;;; Copyright © 2019 Christopher Baines @@ -88,6 +88,7 @@ match from any for local action inbound (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "opensmptd") (test-assert "service is running" @@ -157,8 +158,7 @@ match from any for local action inbound (sleep 1) (wait (- n 1)))))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "opensmtpd-test" test)) @@ -233,6 +233,7 @@ acl_check_data: (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "exim") (test-assert "service is running" @@ -285,8 +286,7 @@ acl_check_data: (lambda (x) (not (string-prefix? "." x)))))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "exim-test" test)) @@ -341,6 +341,7 @@ Subject: Hello Nice to meet you!") (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "dovecot") ;; Wait for dovecot to be up and running. @@ -399,8 +400,7 @@ Subject: Hello Nice to meet you!") get-string-all))))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "dovecot-test" test)) @@ -492,6 +492,7 @@ Subject: Hello Nice to meet you!") (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "getmail") ;; Wait for dovecot to be up and running. @@ -577,8 +578,7 @@ Subject: Hello Nice to meet you!") marionette) message)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "getmail-test" test)) diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm index 176e3d08cb..db9516a485 100644 --- a/gnu/tests/messaging.scm +++ b/gnu/tests/messaging.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018 Clément Lassieur -;;; Copyright © 2017, 2018 Ludovic Courtès +;;; Copyright © 2017, 2018, 2021 Ludovic Courtès ;;; Copyright © 2018 Efraim Flashner ;;; ;;; This file is part of GNU Guix. @@ -101,6 +101,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "xmpp") ;; Wait for XMPP service to be up and running. @@ -128,8 +129,7 @@ (system* freetalk-bin "-s" #$script.ft) (host-wait-for-file #$witness))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation name test)) @@ -194,6 +194,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "bitlbee") (test-assert "service started" @@ -231,8 +232,7 @@ (->bool (string-contains (pk 'message (read-line sock)) "BitlBee")))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "bitlbee-test" test)) @@ -267,6 +267,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "quassel") (test-assert "service started" @@ -281,8 +282,7 @@ '(file-exists? "/var/lib/quassel/quasselCert.pem") marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "quassel-test" test)) diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm index 8630f5818c..5039e22765 100644 --- a/gnu/tests/monitoring.scm +++ b/gnu/tests/monitoring.scm @@ -66,6 +66,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin #$name) (test-assert "prometheus-node-exporter running" @@ -87,8 +88,7 @@ (http-get "http://localhost:8080"))) (response-code response)))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (string-append name "-test") test)) @@ -168,6 +168,7 @@ cat ~a | sudo -u zabbix psql zabbix; (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin #$name) ;; XXX: Shepherd reads the config file *before* binding its control @@ -296,9 +297,7 @@ zabbix||{} (test-url "/") (test-url "/does-not-exist" 404)) - (test-end) - - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (string-append name "-test") test)) diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm index 453e63f52d..fc2060b3ec 100644 --- a/gnu/tests/networking.scm +++ b/gnu/tests/networking.scm @@ -107,6 +107,7 @@ port 7, and a dict service on port 2628." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "inetd") ;; Make sure the PID file is created. @@ -137,8 +138,7 @@ port 7, and a dict service on port 2628." (close dict) response))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "inetd-test" test)) @@ -207,6 +207,7 @@ port 7, and a dict service on port 2628." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "openvswitch") ;; Make sure the bridge is created. @@ -244,8 +245,7 @@ port 7, and a dict service on port 2628." (current-services)))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "openvswitch-test" test)) @@ -307,6 +307,7 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "dhcpd") (test-assert "pid file exists" @@ -339,8 +340,7 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (current-services)))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "dhcpd-test" test)) @@ -402,6 +402,7 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "tor") ;; Test the usual Tor service. @@ -433,8 +434,7 @@ subnet 192.168.1.0 netmask 255.255.255.0 { (wait-for-unix-socket "/var/run/tor/socks-sock" marionette/unix-socks-socket))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "tor-test" test)) @@ -529,6 +529,7 @@ COMMIT (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "iptables") (test-equal "iptables-save dumps the same rules that were loaded" @@ -557,8 +558,7 @@ COMMIT ;; marionette) ;; (wait-for-tcp-port inetd-echo-port marionette #:timeout 5))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "iptables" test)) @@ -625,6 +625,7 @@ COMMIT (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "ipfs") ;; Test the IPFS service. @@ -644,8 +645,7 @@ COMMIT test-bv (read-contents (add-data test-bv))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "ipfs-test" test)) (define %test-ipfs diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm index a0c091eadb..7b6aa51cac 100644 --- a/gnu/tests/nfs.scm +++ b/gnu/tests/nfs.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2020 Ludovic Courtès +;;; Copyright © 2016, 2017, 2020, 2021 Ludovic Courtès ;;; Copyright © 2016 John Darrington ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2017 Tobias Geerinckx-Rice @@ -95,6 +95,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "rpc-daemon") ;; Wait for the rpcbind daemon to be up and running. @@ -130,8 +131,7 @@ '(zero? (system* "rpcinfo" "-p")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation name test)) @@ -201,6 +201,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "nfs-daemon") (marionette-eval '(begin @@ -252,8 +253,7 @@ "nfs-server:/" "/remote" "-v")) (file-exists? "/remote/hello"))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "nfs-server-test" test)) @@ -313,6 +313,7 @@ directories can be mounted.") (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "start-nfs-boot-test") ;;; Start up NFS server host. @@ -401,8 +402,7 @@ directories can be mounted.") (call-with-input-file "/export/mounts" display)) server-marionette) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "nfs-root-fs-test" test)) diff --git a/gnu/tests/package-management.scm b/gnu/tests/package-management.scm index 087eaf923e..7033f040dd 100644 --- a/gnu/tests/package-management.scm +++ b/gnu/tests/package-management.scm @@ -63,6 +63,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin #$name) ;; XXX: Shepherd reads the config file *before* binding its control @@ -105,9 +106,7 @@ derivation { "guix-test.nix"))) marionette)) - (test-end) - - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (string-append name "-test") test)) diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm index 001b5d185a..b97fedcf6b 100644 --- a/gnu/tests/reconfigure.scm +++ b/gnu/tests/reconfigure.scm @@ -82,6 +82,7 @@ generation of the system profile." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "switch-to-system") (let ((generations-prior (system-generations marionette))) @@ -112,8 +113,7 @@ generation of the system profile." "jakob") marionette))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "switch-to-system" (test (switch-system-program os)))) @@ -156,6 +156,7 @@ Shepherd (PID 1) by unloading obsolete services and loading new services." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "upgrade-services") (let ((services-prior (running-services marionette))) @@ -176,8 +177,7 @@ Shepherd (PID 1) by unloading obsolete services and loading new services." (test-assert "script stopped obsolete service" (not (memq 'dummy (running-services marionette))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "upgrade-services" @@ -223,6 +223,7 @@ bootloader's configuration file." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "install-bootloader") (test-assert "no prior menu entry for system generation" @@ -236,8 +237,7 @@ bootloader's configuration file." (test-assert "menu entry created for system generation" (member #$os (generations-in-grub-cfg marionette))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (let* ((bootloader ((compose bootloader-configuration-bootloader operating-system-bootloader) diff --git a/gnu/tests/rsync.scm b/gnu/tests/rsync.scm index 24e60d9d9d..2227edf30d 100644 --- a/gnu/tests/rsync.scm +++ b/gnu/tests/rsync.scm @@ -57,6 +57,7 @@ PORT." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "rsync") ;; Wait for rsync to be up and running. @@ -106,8 +107,7 @@ PORT." (read-line port)))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "rsync-test" test)) diff --git a/gnu/tests/security-token.scm b/gnu/tests/security-token.scm index 1169a4b9fd..d28d23a1ae 100644 --- a/gnu/tests/security-token.scm +++ b/gnu/tests/security-token.scm @@ -47,6 +47,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "pcscd") (test-assert "pcscd is alive" @@ -59,8 +60,7 @@ (current-services)))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "pcscd" test)) diff --git a/gnu/tests/singularity.scm b/gnu/tests/singularity.scm index 1fc2773a00..ac2dec19b8 100644 --- a/gnu/tests/singularity.scm +++ b/gnu/tests/singularity.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -75,6 +75,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "singularity") (test-assert "singularity exec /bin/guile (as root)" @@ -126,8 +127,7 @@ "--debug" "run" #$image "-c" "(use-modules (json))")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "singularity-test" test)) diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm index 10438ad22a..7442bd1c2e 100644 --- a/gnu/tests/ssh.scm +++ b/gnu/tests/ssh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2017 Marius Bakke ;;; @@ -111,6 +111,7 @@ root with an empty password." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "ssh-daemon") ;; Wait for sshd to be up and running. @@ -209,8 +210,7 @@ root with an empty password." (channel-request-exec channel "path-witness") (zero? (channel-get-exit-status channel)))))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0)))))) + (test-end))))) (gexp->derivation name test)) diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm index aeb6500c47..2d44d00165 100644 --- a/gnu/tests/telephony.scm +++ b/gnu/tests/telephony.scm @@ -141,6 +141,7 @@ accounts provisioning feature of the service." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "jami") (test-assert "service is running" @@ -341,8 +342,7 @@ accounts provisioning feature of the service." account-details))))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (if provisioning? "jami-provisioning-test" diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm index a7cde1f163..c45c2d297c 100644 --- a/gnu/tests/version-control.scm +++ b/gnu/tests/version-control.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018 Oleg Pykhalov -;;; Copyright © 2017, 2018, 2020 Ludovic Courtès +;;; Copyright © 2017, 2018, 2020, 2021 Ludovic Courtès ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2018 Christopher Baines ;;; @@ -135,6 +135,7 @@ HTTP-PORT." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "cgit") ;; XXX: Shepherd reads the config file *before* binding its control @@ -210,8 +211,7 @@ HTTP-PORT." (test-url "/test/tree/does-not-exist" 404) (test-url "/does-not-exist" 404)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "cgit-test" test)) @@ -273,6 +273,7 @@ HTTP-PORT." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "git-http") ;; Wait for nginx to be up and running. @@ -302,8 +303,7 @@ HTTP-PORT." (call-with-input-file "/tmp/clone/README" get-string-all))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "git-http" test)) @@ -370,6 +370,7 @@ HTTP-PORT." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "gitolite") ;; Wait for sshd to be up and running. @@ -410,8 +411,7 @@ HTTP-PORT." (test-assert "pushing, and the associated hooks" (invoke #$(file-append git "/bin/git") "push"))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "gitolite" test)) @@ -475,6 +475,7 @@ HTTP-PORT." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "gitile") ;; XXX: Shepherd reads the config file *before* binding its control @@ -540,8 +541,7 @@ HTTP-PORT." (test-url "/test/tree/-/does-not-exist" 404) (test-url "/does-not-exist" 404)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "gitile-test" test)) diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm index 9f9d3a5e26..73f19db4e5 100644 --- a/gnu/tests/virtualization.scm +++ b/gnu/tests/virtualization.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Christopher Baines -;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2020, 2021 Ludovic Courtès ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2021 Pierre Langlois ;;; @@ -76,6 +76,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "libvirt") (test-assert "service running" @@ -107,8 +108,7 @@ "-c" "qemu:///system" "connect")) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "libvirt-test" test)) @@ -196,6 +196,7 @@ (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "childhurd") (test-assert "service running" @@ -250,8 +251,7 @@ (open-input-pipe #$run-uname-over-ssh))) marionette)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "childhurd-test" test)) diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 518c9c1ff3..c9b6f17f07 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2020 Ludovic Courtès +;;; Copyright © 2017, 2020, 2021 Ludovic Courtès ;;; Copyright © 2017, 2019 Christopher Baines ;;; Copyright © 2017, 2018 Clément Lassieur ;;; Copyright © 2018 Pierre-Antoine Rouby @@ -116,6 +116,7 @@ HTTP-PORT." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin #$name) (test-assert #$(string-append name " service running") @@ -150,8 +151,7 @@ HTTP-PORT." marionette))) '()) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (string-append name "-test") test)) @@ -312,6 +312,7 @@ HTTP-PORT, along with php-fpm." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "php-fpm") (test-assert "php-fpm running" @@ -350,9 +351,7 @@ HTTP-PORT, along with php-fpm." (and matches (match:substring matches 0)))))) - (test-end) - - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "php-fpm-test" test)) @@ -397,6 +396,7 @@ HTTP-PORT, along with php-fpm." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin #$name) (test-assert "hpcguix-web running" @@ -422,8 +422,7 @@ HTTP-PORT, along with php-fpm." #:times 10 #:delay 5))) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation (string-append name "-test") test)) @@ -489,6 +488,7 @@ HTTP-PORT." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "tailon") (test-assert "service running" @@ -512,8 +512,7 @@ HTTP-PORT." #:times 10 #:delay 5)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "tailon-test" test)) @@ -633,6 +632,7 @@ HTTP-PORT." (mkdir #$output) (chdir #$output) + (test-runner-current (system-test-runner)) (test-begin "patchwork") (test-assert "patchwork-postgresql-user-and-service started" @@ -667,8 +667,7 @@ HTTP-PORT." #:times 10 #:delay 5)) - (test-end) - (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (test-end)))) (gexp->derivation "patchwork-test" test))