[tests] Simplify test code: extract shared assertion helpers, trim vps-base.scm.

- Add tests/common.scm with assert-service-running and
  assert-binary-exists helpers, DRYing patterns repeated
  across 6 per-component test files.
- Remove unnecessary let block from %test-vps — test
  functions already have descriptive names.
- Inline single-use os binding in run-vps-test.

Co-Authored-By: Claude <noreply@anthropic.com>

diff --git a/tests/claude-code.scm b/tests/claude-code.scm
index 8e3865bdd102f619981079cb82884e9f48e121c0..561a09596b6e6b9a3783b12ecdccf0745b39c206 100644 (file)
--- a/tests/claude-code.scm
+++ b/tests/claude-code.scm
@@ -5,13 +5,12 @@
 
 (define-module (tests claude-code)
   #:use-module (guix gexp)
+  #:use-module (tests common)
   #:use-module (conf home claude)
   #:export (claude-code-test-cases))
 
 (define (claude-code-test-cases marionette)
   "Return a gexp with Claude Code test assertion."
   #~(begin
-      (test-assert "claude: binary exists"
-                   (marionette-eval '(file-exists? (string-append #$claude-code
-                                                    "/bin/claude"))
-                                    #$marionette))))
+      #$(assert-binary-exists "claude: binary exists" claude-code "claude"
+                              marionette)))

diff --git a/tests/common.scm b/tests/common.scm
new file mode 100644 (file)
index 0000000..1b07d61
--- /dev/null
+++ b/tests/common.scm
@@ -0,0 +1,24 @@
+;;; Copyright (c) 2026 Jakub Czajka <jakub@ekhem.eu.org>
+;;; License: GPL-3.0 or later.
+;;;
+;;; Shared test assertion helpers for VPS test suite.
+
+(define-module (tests common)
+  #:use-module (guix gexp)
+  #:export (assert-service-running assert-binary-exists))
+
+(define (assert-service-running label service-name marionette-gexp)
+  "Return a gexp that asserts the Shepherd service SERVICE-NAME is
+running."
+  #~(test-assert #$label
+                 (marionette-eval '(begin
+                                     (use-modules (gnu services herd))
+                                     (start-service '#$service-name))
+                                  #$marionette-gexp)))
+
+(define (assert-binary-exists label pkg binary-name marionette-gexp)
+  "Return a gexp that asserts BINARY-NAME exists inside PKG."
+  #~(test-assert #$label
+                 (marionette-eval '(file-exists? (string-append #$pkg "/bin/"
+                                                                #$binary-name))
+                                  #$marionette-gexp)))

diff --git a/tests/dnscrypt.scm b/tests/dnscrypt.scm
index a486ab2432abec11ba96725e74dca4fc74f2195c..64d7d261bd68c70d4bb508b19c951d3e91e4b4ee 100644 (file)
--- a/tests/dnscrypt.scm
+++ b/tests/dnscrypt.scm
@@ -5,16 +5,14 @@
 
 (define-module (tests dnscrypt)
   #:use-module (guix gexp)
+  #:use-module (tests common)
   #:export (dnscrypt-test-cases))
 
 (define (dnscrypt-test-cases marionette)
   "Return a gexp with dnscrypt-proxy test assertions."
   #~(begin
-      (test-assert "dnscrypt: service running"
-                   (marionette-eval '(begin
-                                       (use-modules (gnu services herd))
-                                       (start-service 'dnscrypt-proxy))
-                                    #$marionette))
+      #$(assert-service-running "dnscrypt: service running"
+                                'dnscrypt-proxy marionette)
 
       (test-assert "dnscrypt: port 53 TCP"
                    (wait-for-tcp-port 53

diff --git a/tests/networking.scm b/tests/networking.scm
index d08ad5f9fe4fdca4ba9a830e85554cf3b46def95..3ad93cf4b1dce091e2d868500904a62cb255c329 100644 (file)
--- a/tests/networking.scm
+++ b/tests/networking.scm
@@ -5,16 +5,14 @@
 
 (define-module (tests networking)
   #:use-module (guix gexp)
+  #:use-module (tests common)
   #:export (networking-test-cases))
 
 (define (networking-test-cases marionette)
   "Return a gexp with static networking test assertions."
   #~(begin
-      (test-assert "net: service running"
-                   (marionette-eval '(begin
-                                       (use-modules (gnu services herd))
-                                       (start-service 'networking))
-                                    #$marionette))
+      #$(assert-service-running "net: service running"
+                                'networking marionette)
 
       (test-assert "net: eth0 is up"
                    (marionette-eval '(file-exists?

diff --git a/tests/ntp.scm b/tests/ntp.scm
index 8f3fc255761a5ab10b4d8b781fdd4a22f910f02e..11d1c4fdd028a3a99082ee241c9053f028dfb6c0 100644 (file)
--- a/tests/ntp.scm
+++ b/tests/ntp.scm
@@ -5,13 +5,11 @@
 
 (define-module (tests ntp)
   #:use-module (guix gexp)
+  #:use-module (tests common)
   #:export (ntp-test-cases))
 
 (define (ntp-test-cases marionette)
   "Return a gexp with NTP daemon test assertion."
   #~(begin
-      (test-assert "ntp: ntpd running"
-                   (marionette-eval '(begin
-                                       (use-modules (gnu services herd))
-                                       (start-service 'ntpd))
-                                    #$marionette))))
+      #$(assert-service-running "ntp: ntpd running"
+                                'ntpd marionette)))

diff --git a/tests/paseo.scm b/tests/paseo.scm
index 5c5e0bb2c4ca13ff0885bafc6af231e4775e296a..e2773253b81113bd24bb12e1d8908e40e8240cb2 100644 (file)
--- a/tests/paseo.scm
+++ b/tests/paseo.scm
@@ -5,13 +5,11 @@
 
 (define-module (tests paseo)
   #:use-module (guix gexp)
+  #:use-module (tests common)
   #:use-module (conf home paseo)
   #:export (paseo-test-cases))
 
 (define (paseo-test-cases marionette)
   "Return a gexp with Paseo test assertion."
   #~(begin
-      (test-assert "paseo: binary exists"
-                   (marionette-eval '(file-exists? (string-append #$paseo
-                                                    "/bin/paseo"))
-                                    #$marionette))))
+      #$(assert-binary-exists "paseo: binary exists" paseo "paseo" marionette)))

diff --git a/tests/sshd.scm b/tests/sshd.scm
index 9ac502310849bee14702ba384bbf23a3bed35789..9b3281d616c76a950f3116f196d857a781d750e7 100644 (file)
--- a/tests/sshd.scm
+++ b/tests/sshd.scm
@@ -5,16 +5,14 @@
 
 (define-module (tests sshd)
   #:use-module (guix gexp)
+  #:use-module (tests common)
   #:export (sshd-test-cases))
 
 (define (sshd-test-cases marionette connect-gexp)
   "Return a gexp with SSH daemon test assertions."
   #~(begin
-      (test-assert "sshd: service running"
-                   (marionette-eval '(begin
-                                       (use-modules (gnu services herd))
-                                       (start-service 'ssh-daemon))
-                                    #$marionette))
+      #$(assert-service-running "sshd: service running"
+                                'ssh-daemon marionette)
 
       (test-assert "sshd: port 72 TCP"
                    (wait-for-tcp-port 72

diff --git a/tests/vps-base.scm b/tests/vps-base.scm
index a074d196f3ed3a014b9244b1fcf5afb485d0694b..e3b3796368c46707e920152943de6dd3ec31ffd0 100644 (file)
--- a/tests/vps-base.scm
+++ b/tests/vps-base.scm
@@ -144,11 +144,9 @@ command, runs a shell command, and verifies the witness file."
   "Return a derivation that boots a VM with %vps-test-os and runs
 every function in TEST-CASES.  Each element is a function
 (marionette-gexp) -> gexp that returns test assertions."
-  (define os
-    %vps-test-os)
   (define vm
     (virtual-machine (operating-system
-                       os)
+                       %vps-test-os)
                      (port-forwardings '((2222 . 72)))))
 
   (define test
@@ -193,23 +191,16 @@ every function in TEST-CASES.  Each element is a function
 ;;;
 
 (define %test-vps
-  (let ((ssh (lambda (m)
-               (sshd-test-cases m
-                                (make-ssh-connect m))))
-        (net networking-test-cases)
-        (ntp ntp-test-cases)
-        (dns dnscrypt-test-cases)
-        (claude claude-code-test-cases)
-        (paseo paseo-test-cases)
-        (dots dotfiles-test-cases)
-        (home home-activation-test-cases))
-    (system-test (name "vps")
-                 (description "VPS test suite.")
-                 (value (run-vps-test (list ssh
-                                            net
-                                            ntp
-                                            dns
-                                            claude
-                                            paseo
-                                            dots
-                                            home))))))
+  (system-test (name "vps")
+               (description "VPS test suite.")
+               (value (run-vps-test (list (lambda (m)
+                                            (sshd-test-cases m
+                                                             (make-ssh-connect
+                                                              m)))
+                                          networking-test-cases
+                                          ntp-test-cases
+                                          dnscrypt-test-cases
+                                          claude-code-test-cases
+                                          paseo-test-cases
+                                          dotfiles-test-cases
+                                          home-activation-test-cases)))))