GNU bug report logs - #76636
[PATCH 0/5] Test guix-daemon on Guix System

Previous Next

Full log

View this message in rfc822 format

From: Ludovic Courtès <ludo <at> gnu.org>
To: 76636 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [bug#76636] [PATCH 5/5] tests: Factorize ‘guix-daemon’ test cases.
Date: Fri, 28 Feb 2025 11:04:32 +0100

* gnu/tests/base.scm (guix-daemon-test-cases): New procedure, with code
moved from…
(run-guix-daemon-test): … here. Use it.
* gnu/tests/foreign.scm (run-foreign-install-test): Likewise.

Change-Id: I6f2d03d30d7b7648b6eb7e77e36c3da54f80d79c
---
 gnu/tests/base.scm    | 160 ++++++++++++++++++++++--------------------
 gnu/tests/foreign.scm |  73 +------------------
 2 files changed, 87 insertions(+), 146 deletions(-)

diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index f2122d7d0a5..a7f8a5bf7c6 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -62,6 +62,7 @@ (define-module (gnu tests base)
             %test-activation
 
             %hello-dependencies-manifest
+            guix-daemon-test-cases
             %test-guix-daemon))
 
 (define %simple-os
@@ -1034,6 +1035,88 @@ (define %hello-dependencies-manifest
           (packages->manifest (list (canonical-package guile-3.0)
                                     %bootstrap-guile))))))
 
+(define (guix-daemon-test-cases marionette)
+  "Return a gexp with SRFI-64 test cases testing guix-daemon.  Those test are
+evaluated in MARIONETTE, a gexp denoting a marionette (system under test).
+Assume that an unprivileged account for 'user' exists on the system under
+test."
+  #~(begin
+      (test-equal "guix describe"
+        0
+        (marionette-eval '(system* "guix" "describe")
+                         #$marionette))
+
+      (test-equal "hello not already built"
+        #f
+        ;; Check that the next test will really build 'hello'.
+        (marionette-eval '(file-exists?
+                           #$(with-parameters ((%graft? #f))
+                               hello))
+                         #$marionette))
+
+      (test-equal "guix build hello"
+        0
+        ;; Check that guix-daemon is up and running and that the build
+        ;; environment is properly set up (build users, etc.).
+        (marionette-eval '(system* "guix" "build" "hello" "--no-grafts")
+                         #$marionette))
+
+      (test-assert "hello indeed built"
+        (marionette-eval '(file-exists?
+                           #$(with-parameters ((%graft? #f))
+                               hello))
+                         #$marionette))
+
+      (test-equal "guix install hello"
+        0
+        ;; Check that ~/.guix-profile & co. are properly created.
+        (marionette-eval '(let ((pw (getpwuid (getuid))))
+                            (setenv "USER" (passwd:name pw))
+                            (setenv "HOME" (pk 'home (passwd:dir pw)))
+                            (system* "guix" "install" "hello"
+                                     "--no-grafts" "--bootstrap"))
+                         #$marionette))
+
+      (test-equal "user profile created"
+        0
+        (marionette-eval '(system "ls -lad ~/.guix-profile")
+                         #$marionette))
+
+      (test-equal "hello"
+        0
+        (marionette-eval '(system "~/.guix-profile/bin/hello")
+                         #$marionette))
+
+      (test-equal "guix install hello, unprivileged user"
+        0
+        ;; Check that 'guix' is in $PATH for new users and that
+        ;; ~user/.guix-profile also gets created, assuming that 'user' exists
+        ;; as an unprivileged user account.
+        (marionette-eval '(system "su - user -c \
+'guix install hello --no-grafts --bootstrap'")
+                         #$marionette))
+
+      (test-equal "user hello"
+        0
+        (marionette-eval '(system "~user/.guix-profile/bin/hello")
+                         #$marionette))
+
+      (test-equal "unprivileged user profile created"
+        0
+        (marionette-eval '(system "ls -lad ~user/.guix-profile")
+                         #$marionette))
+
+      (test-equal "store is read-only"
+        EROFS
+        (marionette-eval '(catch 'system-error
+                            (lambda ()
+                              (mkdir (in-vicinity #$(%store-prefix)
+                                                  "whatever"))
+                              0)
+                            (lambda args
+                              (system-error-errno args)))
+                         #$marionette))))
+
 (define (run-guix-daemon-test os)
   (define test-image
     (image (operating-system os)
@@ -1070,82 +1153,7 @@ (define (run-guix-daemon-test os)
           (test-runner-current (system-test-runner #$output))
           (test-begin "guix-daemon")
 
-          (test-equal "guix describe"
-            0
-            (marionette-eval '(system* "guix" "describe")
-                             marionette))
-
-          ;; XXX: What follows is largely copied form (gnu tests foreign).
-
-          (test-equal "hello not already built"
-            #f
-            ;; Check that the next test will really build 'hello'.
-            (marionette-eval '(file-exists?
-                               #$(with-parameters ((%graft? #f))
-                                   hello))
-                             marionette))
-
-          (test-equal "guix build hello"
-            0
-            ;; Check that guix-daemon is up and running and that the build
-            ;; environment is properly set up (build users, etc.).
-            (marionette-eval '(system* "guix" "build" "hello" "--no-grafts")
-                             marionette))
-
-          (test-assert "hello indeed built"
-            (marionette-eval '(file-exists?
-                               #$(with-parameters ((%graft? #f))
-                                   hello))
-                             marionette))
-
-          (test-equal "guix install hello"
-            0
-            ;; Check that ~/.guix-profile & co. are properly created.
-            (marionette-eval '(let ((pw (getpwuid (getuid))))
-                                (setenv "USER" (passwd:name pw))
-                                (setenv "HOME" (pk 'home (passwd:dir pw)))
-                                (system* "guix" "install" "hello"
-                                         "--no-grafts" "--bootstrap"))
-                             marionette))
-
-          (test-equal "user profile created"
-            0
-            (marionette-eval '(system "ls -lad ~/.guix-profile")
-                             marionette))
-
-          (test-equal "hello"
-            0
-            (marionette-eval '(system "~/.guix-profile/bin/hello")
-                             marionette))
-
-          (test-equal "guix install hello, unprivileged user"
-            0
-            ;; Check that 'guix' is in $PATH for new users and that
-            ;; ~user/.guix-profile also gets created.
-            (marionette-eval '(system "su - user -c \
-'guix install hello --no-grafts --bootstrap'")
-                             marionette))
-
-          (test-equal "user hello"
-            0
-            (marionette-eval '(system "~user/.guix-profile/bin/hello")
-                             marionette))
-
-          (test-equal "unprivileged user profile created"
-            0
-            (marionette-eval '(system "ls -lad ~user/.guix-profile")
-                             marionette))
-
-          (test-equal "store is read-only"
-            EROFS
-            (marionette-eval '(catch 'system-error
-                                (lambda ()
-                                  (mkdir (in-vicinity #$(%store-prefix)
-                                                      "whatever"))
-                                  0)
-                                (lambda args
-                                  (system-error-errno args)))
-                             marionette))
+          #$(guix-daemon-test-cases #~marionette)
 
           (test-end))))
 
diff --git a/gnu/tests/foreign.scm b/gnu/tests/foreign.scm
index 9aba803c4d8..79436bf5f24 100644
--- a/gnu/tests/foreign.scm
+++ b/gnu/tests/foreign.scm
@@ -27,7 +27,8 @@ (define-module (gnu tests foreign)
   #:use-module (gnu compression)
   #:use-module (gnu tests)
   #:use-module ((gnu tests base)
-                #:select (%hello-dependencies-manifest))
+                #:select (%hello-dependencies-manifest
+                          guix-daemon-test-cases))
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootstrap)
   #:use-module (gnu packages guile)
@@ -237,81 +238,13 @@ (define (run-foreign-install-test image name)
                                                  (%store-prefix))))))
                              marionette))
 
-          (test-equal "hello not already built"
-            #f
-            ;; Check that the next test will really build 'hello'.
-            (marionette-eval '(file-exists?
-                               #$(with-parameters ((%graft? #f))
-                                   hello))
-                             marionette))
-
-          (test-equal "guix build hello"
-            0
-            ;; Check that guix-daemon is up and running and that the build
-            ;; environment is properly set up (build users, etc.).
-            (marionette-eval '(system* "guix" "build" "hello" "--no-grafts")
-                             marionette))
-
-          (test-assert "hello indeed built"
-            (marionette-eval '(file-exists?
-                               #$(with-parameters ((%graft? #f))
-                                   hello))
-                             marionette))
-
-          (test-equal "guix install hello"
-            0
-            ;; Check that ~/.guix-profile & co. are properly created.
-            (marionette-eval '(let ((pw (getpwuid (getuid))))
-                                (setenv "USER" (passwd:name pw))
-                                (setenv "HOME" (pk 'home (passwd:dir pw)))
-                                (system* "guix" "install" "hello"
-                                         "--no-grafts" "--bootstrap"))
-                             marionette))
-
-          (test-equal "user profile created"
-            0
-            (marionette-eval '(system "ls -lad ~/.guix-profile")
-                             marionette))
-
-          (test-equal "hello"
-            0
-            (marionette-eval '(system "~/.guix-profile/bin/hello")
-                             marionette))
-
           (test-equal "create user account"
             0
             (marionette-eval '(system* "useradd" "-d" "/home/user" "-m"
                                        "user")
                              marionette))
 
-          (test-equal "guix install hello, unprivileged user"
-            0
-            ;; Check that 'guix' is in $PATH for new users and that
-            ;; ~user/.guix-profile also gets created.
-            (marionette-eval '(system "su - user -c \
-'guix install hello --no-grafts --bootstrap'")
-                             marionette))
-
-          (test-equal "user hello"
-            0
-            (marionette-eval '(system "~user/.guix-profile/bin/hello")
-                             marionette))
-
-          (test-equal "unprivileged user profile created"
-            0
-            (marionette-eval '(system "ls -lad ~user/.guix-profile")
-                             marionette))
-
-          (test-equal "store is read-only"
-            EROFS
-            (marionette-eval '(catch 'system-error
-                                (lambda ()
-                                  (mkdir (in-vicinity #$(%store-prefix)
-                                                      "whatever"))
-                                  0)
-                                (lambda args
-                                  (system-error-errno args)))
-                             marionette))
+          #$(guix-daemon-test-cases #~marionette)
 
           (test-assert "screenshot after"
             (marionette-control (string-append "screendump " #$output
-- 
2.48.1

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.