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

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

8 files changed, 40 insertions, 31 deletions

diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm
index 7c8b87942f9..fd5041344b6 100644
--- a/gnu/tests/databases.scm
+++ b/gnu/tests/databases.scm
@@ -79,7 +79,7 @@
                   (#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 @@ data double PRECISION NULL
                   (#f #f)
                   (('service response-parts ...)
                    (match (assq-ref response-parts 'running)
-                     ((pid) (number? pid))))))
+                     ((pid) pid)))))
              marionette))
 
           (test-assert "mysql_upgrade completed"
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 46c886580c3..90c8d0f8508 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -97,7 +97,7 @@ inside %DOCKER-OS."
                   (#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 @@ inside %DOCKER-OS."
                   (#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 @@ inside %DOCKER-OS."
                   (#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 @@ inside %DOCKER-OS."
                   (#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 @@ docker-image} inside Docker.")
                   (#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 @@ docker-image} inside Docker.")
                   (#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 @@ docker-image} inside Docker.")
                   (#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"
diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm
index 98afc4a3506..fbc779828c4 100644
--- a/gnu/tests/guix.scm
+++ b/gnu/tests/guix.scm
@@ -90,7 +90,7 @@
                   (#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 @@ host	all	all	::1/128 	trust"))))))
                   (#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 @@ host	all	all	::1/128 	trust"))))))
                   (#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 @@ host	all	all	::1/128 	trust"))))))
                   (#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 @@ host	all	all	::1/128 	trust"))))))
                   (#f #f)
                   (('service response-parts ...)
                    (match (assq-ref response-parts 'running)
-                     ((pid) (number? pid))))))
+                     ((pid) pid)))))
              marionette))
 
           (test-equal "http-get"
diff --git a/gnu/tests/ldap.scm b/gnu/tests/ldap.scm
index d5ab6899cf8..2cf7491f3e5 100644
--- a/gnu/tests/ldap.scm
+++ b/gnu/tests/ldap.scm
@@ -124,7 +124,7 @@ suffix = dc=example,dc=com")))
                   (#f #f)
                   (('service response-parts ...)
                    (match (assq-ref response-parts 'running)
-                     ((pid) (number? pid))))))
+                     ((pid) pid)))))
              marionette))
 
           (test-assert "nslcd produces a log file"
diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm
index a0c8c929b11..a9545410ecd 100644
--- a/gnu/tests/monitoring.scm
+++ b/gnu/tests/monitoring.scm
@@ -74,7 +74,7 @@
                   (#f #f)
                   (('service response-parts ...)
                    (match (assq-ref response-parts 'running)
-                     ((pid) (number? pid))))))
+                     ((pid) pid)))))
              marionette))
 
           (test-equal "http-get"
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index 3f550db5eac..4882c7a88b1 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -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 @@ root with an empty password."
               (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))
diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm
index ed8d6b1c85b..a3c9c4014b3 100644
--- a/gnu/tests/virtualization.scm
+++ b/gnu/tests/virtualization.scm
@@ -91,7 +91,7 @@
                   (#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 @@
                   (#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 @@ output."
                   (#f #f)
                   (('service response-parts ...)
                    (match (assq-ref response-parts 'running)
-                     ((pid) (number? pid))))))
+                     ((pid) pid)))))
              marionette))
 
           (test-equal "childhurd SSH server replies"
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index a071e05e1d8..df937f38d4e 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -128,7 +128,7 @@ HTTP-PORT."
                   (('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 @@ HTTP-PORT, along with php-fpm."
                   (#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 @@ HTTP-PORT, along with php-fpm."
                   (#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 @@ HTTP-PORT."
                   (('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 @@ HTTP-PORT."
                   (('service response-parts ...)
                    (match (assq-ref response-parts 'running)
                      ((#t) #t)
-                     ((pid) (number? pid))))))
+                     ((pid) pid)))))
              marionette))
 
           (test-assert "Agate TCP port ready, IPv4"