aboutsummaryrefslogtreecommitdiff
path: root/gnu/tests
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests')
-rw-r--r--gnu/tests/databases.scm4
-rw-r--r--gnu/tests/docker.scm14
-rw-r--r--gnu/tests/guix.scm10
-rw-r--r--gnu/tests/ldap.scm2
-rw-r--r--gnu/tests/monitoring.scm2
-rw-r--r--gnu/tests/ssh.scm23
-rw-r--r--gnu/tests/virtualization.scm6
-rw-r--r--gnu/tests/web.scm10
8 files changed, 40 insertions, 31 deletions
diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm
index 7c8b87942f..fd5041344b 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 46c886580c..90c8d0f850 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 98afc4a350..fbc779828c 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 d5ab6899cf..2cf7491f3e 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 a0c8c929b1..a9545410ec 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 3f550db5ea..4882c7a88b 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 ed8d6b1c85..a3c9c4014b 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 a071e05e1d..df937f38d4 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"
generated by cgit