From: Jakub Czajka Date: Mon, 20 Jul 2026 21:21:21 +0000 (+0000) Subject: [tests] Simplify test code: extract shared assertion helpers, trim vps-base.scm. X-Git-Url: https://git.ekhem.eu.org/?a=commitdiff_plain;h=ec615f673dbc7183b9a8ae44a30cfb3b253bdf86;p=guix.git [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 --- diff --git a/tests/claude-code.scm b/tests/claude-code.scm index 8e3865b..561a095 100644 --- 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 index 0000000..1b07d61 --- /dev/null +++ b/tests/common.scm @@ -0,0 +1,24 @@ +;;; Copyright (c) 2026 Jakub Czajka +;;; 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 a486ab2..64d7d26 100644 --- 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 d08ad5f..3ad93cf 100644 --- 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 8f3fc25..11d1c4f 100644 --- 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 5c5e0bb..e277325 100644 --- 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 9ac5023..9b3281d 100644 --- 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 a074d19..e3b3796 100644 --- 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)))))