mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-18 13:36:36 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: Adjust for new return value of ‘start-service’.

Browse source 
In Shepherd 1.0, the “running value” of processes is no longer a plain
integer; instead, it is a (process …) sexp.  This commit adjusts tests
to this change in a way that works both for 1.0 and for previous
versions.

* gnu/tests/databases.scm (run-memcached-test)
(run-mysql-test): Don’t expect PID to be a number.
* gnu/tests/docker.scm (run-docker-test)
(run-docker-system-test, run-oci-container-test): Likewise.
* gnu/tests/guix.scm (run-guix-build-coordinator-test)
(run-guix-data-service-test, run-nar-herder-test)
(run-bffe-test): Likewise.
* gnu/tests/ldap.scm (run-ldap-test): Likewise.
* gnu/tests/monitoring.scm (run-prometheus-node-exporter-server-test):
Likewise.
* gnu/tests/virtualization.scm (run-libvirt-test)
(run-qemu-guest-agent-test, run-childhurd-test): Likewise.
* gnu/tests/web.scm (run-webserver-test, run-php-fpm-test)
(run-hpcguix-web-server-test, run-patchwork-test)
(run-agate-test): Likewise
* gnu/tests/ssh.scm (run-ssh-test): Accept a number, an ‘inetd-service’
sexp, or a ‘process’ sexp.

Change-Id: I8c7a37a981f0788780fbc33752a38e7f9a026437
This commit is contained in:
Ludovic Courtès 2024-12-09 22:41:29 +01:00
parent 51ee3a7278
commit e7cd328714
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
8 changed files with 40 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
gnu/tests/databases.scm
View file

@ -79,7 +79,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(let* ((ai (car (getaddrinfo "localhost"
@ -433,7 +433,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "mysql_upgrade completed"

14
gnu/tests/docker.scm
View file

@ -97,7 +97,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "containerd PID file present"
@ -111,7 +111,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-eq "fetch version"
@ -257,7 +257,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "containerd PID file present"
@ -271,7 +271,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "load system image and run it"
@ -422,7 +422,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "containerd PID file present"
@ -436,7 +436,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(sleep 10) ; let service start
@ -449,7 +449,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-equal "passing host environment variables and volumes"

10
gnu/tests/guix.scm
View file

@ -90,7 +90,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-equal "http-get"
@ -212,7 +212,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "process jobs service running"
@ -223,7 +223,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
;; The service starts immediately but replies with status 500 until
@ -378,7 +378,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-equal "http-get"
@ -456,7 +456,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-equal "http-get"

2
gnu/tests/ldap.scm
View file

@ -124,7 +124,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "nslcd produces a log file"

2
gnu/tests/monitoring.scm
View file

@ -74,7 +74,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-equal "http-get"

23
gnu/tests/ssh.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016-2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
@ -124,13 +124,22 @@ (define (call-with-connected-session/auth proc)
(let ((pid (marionette-eval
'(begin
(use-modules (gnu services herd)
(srfi srfi-1))
(srfi srfi-1)
(ice-9 match))
(live-service-running
(find (lambda (live)
(memq 'ssh-daemon
(live-service-provision live)))
(current-services))))
(match (live-service-running
(find (lambda (live)
(memq 'ssh-daemon
(live-service-provision live)))
(current-services)))
((? number? pid)
;; shepherd < 1.0.0
pid)
(('inetd-service _ ...)
#t)
(('process ('version 0 _ ...)
('id pid) _ ...)
pid)))
marionette)))
(if #$pid-file
(= pid (wait-for-file #$pid-file marionette))

6
gnu/tests/virtualization.scm
View file

@ -91,7 +91,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
;; Give the libvirtd service time to start up.
@ -206,7 +206,7 @@ (define (run command)
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-equal "ping guest"
@ -322,7 +322,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-equal "childhurd SSH server replies"

10
gnu/tests/web.scm
View file

@ -128,7 +128,7 @@ (define marionette
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((#t) #t)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "HTTP port ready"
@ -320,7 +320,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "nginx running"
@ -401,7 +401,7 @@ (define marionette
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-equal "http-get"
@ -628,7 +628,7 @@ (define marionette
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((#t) #t)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "httpd running"
@ -728,7 +728,7 @@ (define marionette
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((#t) #t)
((pid) (number? pid))))))
((pid) pid)))))
marionette))
(test-assert "Agate TCP port ready, IPv4"