~ruther/guix-local: tests: Adjust for new return value of ‘start-service’.

8 files changed, 40 insertions(+), 31 deletions(-)

M gnu/tests/databases.scm
M gnu/tests/docker.scm
M gnu/tests/guix.scm
M gnu/tests/ldap.scm
M gnu/tests/monitoring.scm
M gnu/tests/ssh.scm
M gnu/tests/virtualization.scm
M gnu/tests/web.scm

M gnu/tests/databases.scm => gnu/tests/databases.scm +2 -2

@@ 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"

M gnu/tests/docker.scm => gnu/tests/docker.scm +7 -7

@@ 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"

M gnu/tests/guix.scm => gnu/tests/guix.scm +5 -5

@@ 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"

M gnu/tests/ldap.scm => gnu/tests/ldap.scm +1 -1

@@ 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"

M gnu/tests/monitoring.scm => gnu/tests/monitoring.scm +1 -1

@@ 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"

M gnu/tests/ssh.scm => gnu/tests/ssh.scm +16 -7

@@ 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))

M gnu/tests/virtualization.scm => gnu/tests/virtualization.scm +3 -3

@@ 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"

M gnu/tests/web.scm => gnu/tests/web.scm +5 -5

@@ 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"