GNU logs - #76636, boring messages

Message sent to guix-patches@HIDDEN:

Subject: [bug#76636] [PATCH 0/5] Test guix-daemon on Guix System
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 28 Feb 2025 09:58:02 +0000
Resent-Message-ID: <handler.76636.B.174073662523385 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: 76636 <at> debbugs.gnu.org
Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Date: Fri, 28 Feb 2025 10:56:12 +0100
Message-ID: <cover.1740736327.git.ludo@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

Hello Guix!

After writing system tests for Guix installation on Debian¹ and
in light of the need for tests with the “rootless” daemon changes²,
I realized we had no guix-daemon tests , I realized we had no
guix-daemon tests for Guix System—nothing that excercises chroot,
use of the separate build users, etc.

This patch series does that, factorizing most of the code with
the Debian install test (it depends on that patch series).

It also tidies up (gnu tests base).

Thoughts?

Ludo’.

¹ https://issues.guix.gnu.org/76488
² https://issues.guix.gnu.org/75810

Ludovic Courtès (5):
  tests: Move mcron test to its own file.
  tests: Move Avahi test to its own file.
  tests: Add ‘guix-daemon’ test.
  tests: Factorize ‘%hello-dependencies-manifest’.
  tests: Factorize ‘guix-daemon’ test cases.

 gnu/local.mk          |   2 +
 gnu/tests/avahi.scm   | 183 +++++++++++++++++
 gnu/tests/base.scm    | 449 +++++++++++++++++++-----------------------
 gnu/tests/foreign.scm | 107 +---------
 gnu/tests/mcron.scm   | 118 +++++++++++
 5 files changed, 508 insertions(+), 351 deletions(-)
 create mode 100644 gnu/tests/avahi.scm
 create mode 100644 gnu/tests/mcron.scm

base-commit: 4d20e358c38b778b2447bd88ec6abe16b919abc4
-- 
2.48.1

Message sent:

Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable
MIME-Version: 1.0
X-Mailer: MIME-tools 5.505 (Entity 5.505)
Content-Type: text/plain; charset=utf-8
X-Loop: help-debbugs@HIDDEN
From: help-debbugs@HIDDEN (GNU bug Tracking System)
To: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Subject: bug#76636: Acknowledgement ([PATCH 0/5] Test guix-daemon on Guix
 System)
Message-ID: <handler.76636.B.174073662523385.ack <at> debbugs.gnu.org>
References: <cover.1740736327.git.ludo@HIDDEN>
X-Gnu-PR-Message: ack 76636
X-Gnu-PR-Package: guix-patches
X-Gnu-PR-Keywords: patch
Reply-To: 76636 <at> debbugs.gnu.org
Date: Fri, 28 Feb 2025 09:58:02 +0000

Thank you for filing a new bug report with debbugs.gnu.org.

This is an automatically generated reply to let you know your message
has been received.

Your message is being forwarded to the package maintainers and other
interested parties for their attention; they will reply in due course.

Your message has been sent to the package maintainer(s):
 guix-patches@HIDDEN

If you wish to submit further information on this problem, please
send it to 76636 <at> debbugs.gnu.org.

Please do not send mail to help-debbugs@HIDDEN unless you wish
to report a problem with the Bug-tracking system.

--=20
76636: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D76636
GNU Bug Tracking System
Contact help-debbugs@HIDDEN with problems

Message sent to guix-patches@HIDDEN:

Subject: [bug#76636] [PATCH 2/5] tests: Move Avahi test to its own file.
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 28 Feb 2025 10:06:02 +0000
Resent-Message-ID: <handler.76636.B76636.17407371275214 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: 76636 <at> debbugs.gnu.org
Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Date: Fri, 28 Feb 2025 11:04:29 +0100
Message-ID: <e625aa6943ffd3f7d3d24334caf578b7517539ad.1740736327.git.ludo@HIDDEN>
In-Reply-To: <cover.1740736327.git.ludo@HIDDEN>
References: <cover.1740736327.git.ludo@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

This mirrors the (gnu services avahi) module.

* gnu/tests/base.scm (%avahi-os, run-nss-mdns-test, %test-nss-mdns):
Move to…
* gnu/tests/avahi.scm: … here.  New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.

Change-Id: I04705e57408619d948c928873c40c470aa4e949d
---
 gnu/local.mk        |   1 +
 gnu/tests/avahi.scm | 183 ++++++++++++++++++++++++++++++++++++++++++++
 gnu/tests/base.scm  | 156 -------------------------------------
 3 files changed, 184 insertions(+), 156 deletions(-)
 create mode 100644 gnu/tests/avahi.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index 4b31f8a4a0b..d923afd633e 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -838,6 +838,7 @@ GNU_SYSTEM_MODULES =				\
 						\
   %D%/tests.scm					\
   %D%/tests/audio.scm				\
+  %D%/tests/avahi.scm				\
   %D%/tests/base.scm				\
   %D%/tests/cachefilesd.scm			\
   %D%/tests/ci.scm				\
diff --git a/gnu/tests/avahi.scm b/gnu/tests/avahi.scm
new file mode 100644
index 00000000000..261ec8a7312
--- /dev/null
+++ b/gnu/tests/avahi.scm
@@ -0,0 +1,183 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016-2020, 2022, 2024 Ludovic Courtès <ludo@HIDDEN>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests avahi)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system nss)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu services dbus)
+  #:use-module (gnu services avahi)
+  #:use-module (gnu services networking)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:export (%test-nss-mdns))
+
+;;;
+;;; Avahi and NSS-mDNS.
+;;;
+
+(define %avahi-os
+  (operating-system
+    (inherit (simple-operating-system))
+    (name-service-switch %mdns-host-lookup-nss)
+    (services (cons* (service avahi-service-type
+                              (avahi-configuration (debug? #t)))
+                     (service dbus-root-service-type)
+                     (service dhcp-client-service-type) ;needed for multicast
+
+                     ;; Enable heavyweight debugging output.
+                     (modify-services (operating-system-user-services
+                                       %simple-os)
+                       (nscd-service-type config
+                                          => (nscd-configuration
+                                              (inherit config)
+                                              (debug-level 3)
+                                              (log-file "/dev/console")))
+                       (syslog-service-type config
+                                            =>
+                                            (syslog-configuration
+                                             (inherit config)
+                                             (config-file
+                                              (plain-file
+                                               "syslog.conf"
+                                               "*.* /dev/console\n")))))))))
+
+(define (run-nss-mdns-test)
+  ;; Test resolution of '.local' names via libc.  Start the marionette service
+  ;; *after* nscd.  Failing to do that, libc will try to connect to nscd,
+  ;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
+  ;; leading to '.local' resolution failures.
+  (define os
+    (marionette-operating-system
+     %avahi-os
+     #:requirements '(nscd)
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define mdns-host-name
+    (string-append (operating-system-host-name os)
+                   ".local"))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-1)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-runner-current (system-test-runner))
+          (test-begin "avahi")
+
+          (test-assert "nscd PID file is created"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'nscd))
+             marionette))
+
+          (test-assert "nscd is listening on its socket"
+            (marionette-eval
+             ;; XXX: Work around a race condition in nscd: nscd creates its
+             ;; PID file before it is listening on its socket.
+             '(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
+                (let try ()
+                  (catch 'system-error
+                    (lambda ()
+                      (connect sock AF_UNIX "/var/run/nscd/socket")
+                      (close-port sock)
+                      (format #t "nscd is ready~%")
+                      #t)
+                    (lambda args
+                      (format #t "waiting for nscd...~%")
+                      (usleep 500000)
+                      (try)))))
+             marionette))
+
+          (test-assert "avahi is running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'avahi-daemon))
+             marionette))
+
+          (test-assert "network is up"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'networking))
+             marionette))
+
+          (test-equal "avahi-resolve-host-name"
+            0
+            (marionette-eval
+             '(system*
+               "/run/current-system/profile/bin/avahi-resolve-host-name"
+               "-v" #$mdns-host-name)
+             marionette))
+
+          (test-equal "avahi-browse"
+            0
+            (marionette-eval
+             '(system* "/run/current-system/profile/bin/avahi-browse" "-avt")
+             marionette))
+
+          (test-assert "getaddrinfo .local"
+            ;; Wait for the 'avahi-daemon' service and perform a resolution.
+            (match (marionette-eval
+                    '(getaddrinfo #$mdns-host-name)
+                    marionette)
+              (((? vector? addrinfos) ..1)
+               (pk 'getaddrinfo addrinfos)
+               (and (any (lambda (ai)
+                           (= AF_INET (addrinfo:fam ai)))
+                         addrinfos)
+                    (any (lambda (ai)
+                           (= AF_INET6 (addrinfo:fam ai)))
+                         addrinfos)))))
+
+          (test-assert "gethostbyname .local"
+            (match (pk 'gethostbyname
+                       (marionette-eval '(gethostbyname #$mdns-host-name)
+                                        marionette))
+              ((? vector? result)
+               (and (string=? (hostent:name result) #$mdns-host-name)
+                    (= (hostent:addrtype result) AF_INET)))))
+
+
+          (test-end))))
+
+  (gexp->derivation "nss-mdns" test))
+
+(define %test-nss-mdns
+  (system-test
+   (name "nss-mdns")
+   (description
+    "Test Avahi's multicast-DNS implementation, and in particular, test its
+glibc name service switch (NSS) module.")
+   (value (run-nss-mdns-test))))
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index c3040002d37..89e797259dc 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -27,12 +27,9 @@ (define-module (gnu tests base)
   #:autoload   (gnu system image) (system-image)
   #:use-module (gnu system privilege)
   #:use-module (gnu system shadow)
-  #:use-module (gnu system nss)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
-  #:use-module (gnu services dbus)
-  #:use-module (gnu services avahi)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services networking)
   #:use-module (gnu packages base)
@@ -59,7 +56,6 @@ (define-module (gnu tests base)
             %test-halt
             %test-root-unmount
             %test-cleanup
-            %test-nss-mdns
             %test-activation))
 
 (define %simple-os
@@ -870,158 +866,6 @@ (define %test-cleanup
 non-ASCII names from /tmp.")
    (value (run-cleanup-test name))))
 
-
-;;;
-;;; Avahi and NSS-mDNS.
-;;;
-
-(define %avahi-os
-  (operating-system
-    (inherit %simple-os)
-    (name-service-switch %mdns-host-lookup-nss)
-    (services (cons* (service avahi-service-type
-                              (avahi-configuration (debug? #t)))
-                     (service dbus-root-service-type)
-                     (service dhcp-client-service-type) ;needed for multicast
-
-                     ;; Enable heavyweight debugging output.
-                     (modify-services (operating-system-user-services
-                                       %simple-os)
-                       (nscd-service-type config
-                                          => (nscd-configuration
-                                              (inherit config)
-                                              (debug-level 3)
-                                              (log-file "/dev/console")))
-                       (syslog-service-type config
-                                            =>
-                                            (syslog-configuration
-                                             (inherit config)
-                                             (config-file
-                                              (plain-file
-                                               "syslog.conf"
-                                               "*.* /dev/console\n")))))))))
-
-(define (run-nss-mdns-test)
-  ;; Test resolution of '.local' names via libc.  Start the marionette service
-  ;; *after* nscd.  Failing to do that, libc will try to connect to nscd,
-  ;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
-  ;; leading to '.local' resolution failures.
-  (define os
-    (marionette-operating-system
-     %avahi-os
-     #:requirements '(nscd)
-     #:imported-modules '((gnu services herd)
-                          (guix combinators))))
-
-  (define mdns-host-name
-    (string-append (operating-system-host-name os)
-                   ".local"))
-
-  (define test
-    (with-imported-modules '((gnu build marionette))
-      #~(begin
-          (use-modules (gnu build marionette)
-                       (srfi srfi-1)
-                       (srfi srfi-64)
-                       (ice-9 match))
-
-          (define marionette
-            (make-marionette (list #$(virtual-machine os))))
-
-          (mkdir #$output)
-          (chdir #$output)
-
-          (test-runner-current (system-test-runner))
-          (test-begin "avahi")
-
-          (test-assert "nscd PID file is created"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'nscd))
-             marionette))
-
-          (test-assert "nscd is listening on its socket"
-            (marionette-eval
-             ;; XXX: Work around a race condition in nscd: nscd creates its
-             ;; PID file before it is listening on its socket.
-             '(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
-                (let try ()
-                  (catch 'system-error
-                    (lambda ()
-                      (connect sock AF_UNIX "/var/run/nscd/socket")
-                      (close-port sock)
-                      (format #t "nscd is ready~%")
-                      #t)
-                    (lambda args
-                      (format #t "waiting for nscd...~%")
-                      (usleep 500000)
-                      (try)))))
-             marionette))
-
-          (test-assert "avahi is running"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'avahi-daemon))
-             marionette))
-
-          (test-assert "network is up"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'networking))
-             marionette))
-
-          (test-equal "avahi-resolve-host-name"
-            0
-            (marionette-eval
-             '(system*
-               "/run/current-system/profile/bin/avahi-resolve-host-name"
-               "-v" #$mdns-host-name)
-             marionette))
-
-          (test-equal "avahi-browse"
-            0
-            (marionette-eval
-             '(system* "/run/current-system/profile/bin/avahi-browse" "-avt")
-             marionette))
-
-          (test-assert "getaddrinfo .local"
-            ;; Wait for the 'avahi-daemon' service and perform a resolution.
-            (match (marionette-eval
-                    '(getaddrinfo #$mdns-host-name)
-                    marionette)
-              (((? vector? addrinfos) ..1)
-               (pk 'getaddrinfo addrinfos)
-               (and (any (lambda (ai)
-                           (= AF_INET (addrinfo:fam ai)))
-                         addrinfos)
-                    (any (lambda (ai)
-                           (= AF_INET6 (addrinfo:fam ai)))
-                         addrinfos)))))
-
-          (test-assert "gethostbyname .local"
-            (match (pk 'gethostbyname
-                       (marionette-eval '(gethostbyname #$mdns-host-name)
-                                        marionette))
-              ((? vector? result)
-               (and (string=? (hostent:name result) #$mdns-host-name)
-                    (= (hostent:addrtype result) AF_INET)))))
-
-
-          (test-end))))
-
-  (gexp->derivation "nss-mdns" test))
-
-(define %test-nss-mdns
-  (system-test
-   (name "nss-mdns")
-   (description
-    "Test Avahi's multicast-DNS implementation, and in particular, test its
-glibc name service switch (NSS) module.")
-   (value (run-nss-mdns-test))))
-
 
 ;;;
 ;;; Activation: Order of activation scripts
-- 
2.48.1

Message sent to guix-patches@HIDDEN:

Subject: [bug#76636] [PATCH 1/5] tests: Move mcron test to its own file.
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 28 Feb 2025 10:06:03 +0000
Resent-Message-ID: <handler.76636.B76636.17407371295232 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: 76636 <at> debbugs.gnu.org
Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Date: Fri, 28 Feb 2025 11:04:28 +0100
Message-ID: <72781f922736d543f55abe13d439b91d16815dd7.1740736327.git.ludo@HIDDEN>
In-Reply-To: <cover.1740736327.git.ludo@HIDDEN>
References: <cover.1740736327.git.ludo@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

This mirrors the (gnu services mcron) module.

* gnu/tests/base.scm (%mcron-os, run-mcron-test, %test-mcron): Move to…
* gnu/tests/mcron.scm: … here.  New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.

Change-Id: Id2830d08d8e797e008c5fec7964fb5f6a5ea2fad
---
 gnu/local.mk        |   1 +
 gnu/tests/base.scm  |  92 ----------------------------------
 gnu/tests/mcron.scm | 118 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 119 insertions(+), 92 deletions(-)
 create mode 100644 gnu/tests/mcron.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index b5c8c1a4665..4b31f8a4a0b 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -862,6 +862,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests/lightdm.scm			\
   %D%/tests/linux-modules.scm			\
   %D%/tests/mail.scm				\
+  %D%/tests/mcron.scm				\
   %D%/tests/messaging.scm			\
   %D%/tests/networking.scm			\
   %D%/tests/package-management.scm		\
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index d9e30e9b1de..c3040002d37 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -33,7 +33,6 @@ (define-module (gnu tests base)
   #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services avahi)
-  #:use-module (gnu services mcron)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services networking)
   #:use-module (gnu packages base)
@@ -60,7 +59,6 @@ (define-module (gnu tests base)
             %test-halt
             %test-root-unmount
             %test-cleanup
-            %test-mcron
             %test-nss-mdns
             %test-activation))
 
@@ -872,96 +870,6 @@ (define %test-cleanup
 non-ASCII names from /tmp.")
    (value (run-cleanup-test name))))
 
-
-;;;
-;;; Mcron.
-;;;
-
-(define %mcron-os
-  ;; System with an mcron service, with one mcron job for "root" and one mcron
-  ;; job for an unprivileged user.
-  (let ((job1 #~(job '(next-second '(0 5 10 15 20 25 30 35 40 45 50 55))
-                     (lambda ()
-                       (unless (file-exists? "witness")
-                        (call-with-output-file "witness"
-                          (lambda (port)
-                            (display (list (getuid) (getgid)) port)))))))
-        (job2 #~(job next-second-from
-                     (lambda ()
-                       (call-with-output-file "witness"
-                         (lambda (port)
-                           (display (list (getuid) (getgid)) port))))
-                     #:user "alice"))
-        (job3 #~(job next-second-from             ;to test $PATH
-                     "touch witness-touch")))
-    (simple-operating-system
-     (service mcron-service-type
-              (mcron-configuration (jobs (list job1 job2 job3)))))))
-
-(define (run-mcron-test name)
-  (define os
-    (marionette-operating-system
-     %mcron-os
-     #:imported-modules '((gnu services herd)
-                          (guix combinators))))
-
-  (define test
-    (with-imported-modules '((gnu build marionette))
-      #~(begin
-          (use-modules (gnu build marionette)
-                       (srfi srfi-64)
-                       (ice-9 match))
-
-          (define marionette
-            (make-marionette (list #$(virtual-machine os))))
-
-          (test-runner-current (system-test-runner #$output))
-          (test-begin "mcron")
-
-          (test-assert "service running"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'mcron))
-             marionette))
-
-          ;; Make sure root's mcron job runs, has its cwd set to "/root", and
-          ;; runs with the right UID/GID.
-          (test-equal "root's job"
-            '(0 0)
-            (wait-for-file "/root/witness" marionette))
-
-          ;; Likewise for Alice's job.  We cannot know what its GID is since
-          ;; it's chosen by 'groupadd', but it's strictly positive.
-          (test-assert "alice's job"
-            (match (wait-for-file "/home/alice/witness" marionette)
-              ((1000 gid)
-               (>= gid 100))))
-
-          ;; Last, the job that uses a command; allows us to test whether
-          ;; $PATH is sane.
-          (test-equal "root's job with command"
-            ""
-            (wait-for-file "/root/witness-touch" marionette
-                           #:read '(@ (ice-9 rdelim) read-string)))
-
-          ;; Make sure the 'schedule' action is accepted.
-          (test-equal "schedule action"
-            '(#t)                                 ;one value, #t
-            (marionette-eval '(with-shepherd-action 'mcron ('schedule) result
-                                result)
-                             marionette))
-
-          (test-end))))
-
-  (gexp->derivation name test))
-
-(define %test-mcron
-  (system-test
-   (name "mcron")
-   (description "Make sure the mcron service works as advertised.")
-   (value (run-mcron-test name))))
-
 
 ;;;
 ;;; Avahi and NSS-mDNS.
diff --git a/gnu/tests/mcron.scm b/gnu/tests/mcron.scm
new file mode 100644
index 00000000000..052c8439cc7
--- /dev/null
+++ b/gnu/tests/mcron.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016-2020, 2022, 2024 Ludovic Courtès <ludo@HIDDEN>
+;;; Copyright © 2018 Clément Lassieur <clement@HIDDEN>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests mcron)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services mcron)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (guix monads)
+  #:export (%test-mcron))
+
+;;;
+;;; Mcron.
+;;;
+
+(define %mcron-os
+  ;; System with an mcron service, with one mcron job for "root" and one mcron
+  ;; job for an unprivileged user.
+  (let ((job1 #~(job '(next-second '(0 5 10 15 20 25 30 35 40 45 50 55))
+                     (lambda ()
+                       (unless (file-exists? "witness")
+                        (call-with-output-file "witness"
+                          (lambda (port)
+                            (display (list (getuid) (getgid)) port)))))))
+        (job2 #~(job next-second-from
+                     (lambda ()
+                       (call-with-output-file "witness"
+                         (lambda (port)
+                           (display (list (getuid) (getgid)) port))))
+                     #:user "alice"))
+        (job3 #~(job next-second-from             ;to test $PATH
+                     "touch witness-touch")))
+    (simple-operating-system
+     (service mcron-service-type
+              (mcron-configuration (jobs (list job1 job2 job3)))))))
+
+(define (run-mcron-test name)
+  (define os
+    (marionette-operating-system
+     %mcron-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "mcron")
+
+          (test-assert "service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'mcron))
+             marionette))
+
+          ;; Make sure root's mcron job runs, has its cwd set to "/root", and
+          ;; runs with the right UID/GID.
+          (test-equal "root's job"
+            '(0 0)
+            (wait-for-file "/root/witness" marionette))
+
+          ;; Likewise for Alice's job.  We cannot know what its GID is since
+          ;; it's chosen by 'groupadd', but it's strictly positive.
+          (test-assert "alice's job"
+            (match (wait-for-file "/home/alice/witness" marionette)
+              ((1000 gid)
+               (>= gid 100))))
+
+          ;; Last, the job that uses a command; allows us to test whether
+          ;; $PATH is sane.
+          (test-equal "root's job with command"
+            ""
+            (wait-for-file "/root/witness-touch" marionette
+                           #:read '(@ (ice-9 rdelim) read-string)))
+
+          ;; Make sure the 'schedule' action is accepted.
+          (test-equal "schedule action"
+            '(#t)                                 ;one value, #t
+            (marionette-eval '(with-shepherd-action 'mcron ('schedule) result
+                                result)
+                             marionette))
+
+          (test-end))))
+
+  (gexp->derivation name test))
+
+(define %test-mcron
+  (system-test
+   (name "mcron")
+   (description "Make sure the mcron service works as advertised.")
+   (value (run-mcron-test name))))
-- 
2.48.1

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#76636] [PATCH 3/5] tests: Add =?UTF-8?Q?=E2=80=98guix-daemon=E2=80=99?= test.
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 28 Feb 2025 10:06:03 +0000
Resent-Message-ID: <handler.76636.B76636.17407371315246 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 76636
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 76636 <at> debbugs.gnu.org
Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Received: via spool by 76636-submit <at> debbugs.gnu.org id=B76636.17407371315246
          (code B ref 76636); Fri, 28 Feb 2025 10:06:03 +0000
Received: (at 76636) by debbugs.gnu.org; 28 Feb 2025 10:05:31 +0000
Received: from localhost ([127.0.0.1]:45367 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tnxFJ-0001MS-S5
	for submit <at> debbugs.gnu.org; Fri, 28 Feb 2025 05:05:31 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10]:48068)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <ludo@HIDDEN>) id 1tnxFA-0001KY-Eh
 for 76636 <at> debbugs.gnu.org; Fri, 28 Feb 2025 05:05:23 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <ludo@HIDDEN>)
 id 1tnxF4-0000K2-Gx; Fri, 28 Feb 2025 05:05:14 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To:
 From; bh=gslXYDTp9tnGvjUo9kYgOxdttde8RkSNbU5gOnh8fec=; b=U9p0vJQLqADd4eFyOOTR
 S0Qb51sPsJmsok1MoWwgd7PcNP4ljCk66WRgThziGv/+b07id3TkfnQKUEgR0APrz58xParAwETi1
 bwme8R0aRhRN/WVLbcK5SOWIOXNIPv17Heqpka0SA9N9DcztmSMXge6ZDluifFbYFjU9Yi3/zdev4
 gewEotmInZ1/2ESErvpuBJG2zyIKrMj6Q+abUJbVSsneIn/vWUXRZc6NsWFMh24TeluqvsnC8VX/2
 WNRWPtZdKsSBpu5v96g0Azo/pXjYt/wW5ITu1/OPqSzLGk7InBnfz7VLyPmp/V6wbkrXztP7yyZEN
 C9lZoEIMnd5g3Q==;
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Date: Fri, 28 Feb 2025 11:04:30 +0100
Message-ID: <af8b65dd0950c40877f810f5144fa330672f26c2.1740736327.git.ludo@HIDDEN>
X-Mailer: git-send-email 2.48.1
In-Reply-To: <cover.1740736327.git.ludo@HIDDEN>
References: <cover.1740736327.git.ludo@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -2.3 (--)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

* gnu/tests/base.scm (manifest-entry-without-grafts): New procedure.
(%hello-dependencies-manifest): New variable.
(run-guix-daemon-test): New procedure.
(%test-guix-daemon): New variable.

Change-Id: Ia37966de1f61fb428e6fb2244271bf389a74af6d
---
 gnu/tests/base.scm | 191 ++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 190 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 89e797259dc..38bd1e687fc 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -34,6 +34,8 @@ (define-module (gnu tests base)
   #:use-module (gnu services networking)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
+  #:use-module (gnu packages bootstrap)
+  #:use-module (gnu packages guile)
   #:use-module (gnu packages imagemagick)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages ocr)
@@ -45,6 +47,7 @@ (define-module (gnu tests base)
   #:use-module (guix monads)
   #:use-module (guix modules)
   #:use-module (guix packages)
+  #:use-module (guix profiles)
   #:use-module (guix utils)
   #:use-module ((srfi srfi-1) #:hide (partition))
   #:use-module (ice-9 match)
@@ -56,7 +59,8 @@ (define-module (gnu tests base)
             %test-halt
             %test-root-unmount
             %test-cleanup
-            %test-activation))
+            %test-activation
+            %test-guix-daemon))
 
 (define %simple-os
   (simple-operating-system))
@@ -981,3 +985,188 @@ (define %test-activation
    (name "activation")
    (description "Test that activation scripts are run in the correct order")
    (value (run-activation-test name))))
+
+
+;;;
+;;; Build daemon.
+;;;
+
+(define (manifest-entry-without-grafts entry)
+  "Return ENTRY with grafts disabled on its contents."
+  (manifest-entry
+    (inherit entry)
+    (item (with-parameters ((%graft? #f))
+            (manifest-entry-item entry)))))
+
+(define %hello-dependencies-manifest            ;TODO: Share with (gnu tests foreign).
+  ;; Build dependencies of 'hello' needed to test 'guix build hello'.
+  (concatenate-manifests
+   (list (map-manifest-entries
+          manifest-entry-without-grafts
+          (package->development-manifest hello))
+
+         ;; Add the source of 'hello'.
+         (manifest
+          (list (manifest-entry
+                  (name "hello-source")
+                  (version (package-version hello))
+                  (item (let ((file (origin-actual-file-name
+                                     (package-source hello))))
+                          (computed-file
+                           "hello-source"
+                           #~(begin
+                               ;; Put the tarball in a subdirectory since
+                               ;; profile union crashes otherwise.
+                               (mkdir #$output)
+                               (mkdir (in-vicinity #$output "src"))
+                               (symlink #$(package-source hello)
+                                        (in-vicinity #$output
+                                                     (string-append "src/"
+                                                                    #$file))))))))))
+
+         ;; Include 'guile-final', which is needed when building derivations
+         ;; such as that of 'hello' but missing from the development manifest.
+         ;; Add '%bootstrap-guile', used by 'guix install --bootstrap'.
+         (map-manifest-entries
+          manifest-entry-without-grafts
+          (packages->manifest (list (canonical-package guile-3.0)
+                                    %bootstrap-guile))))))
+
+(define (run-guix-daemon-test os)
+  (define test-image
+    (image (operating-system os)
+           (format 'compressed-qcow2)
+           (volatile-root? #f)
+           (shared-store? #f)
+           (partition-table-type 'mbr)
+           (partitions
+            (list (partition
+                   (size (* 4 (expt 2 30)))
+                   (offset (* 512 2048))          ;leave room for GRUB
+                   (flags '(boot))
+                   (label "root"))))))
+
+  (define test
+    (with-imported-modules (source-module-closure
+                            '((gnu build marionette)
+                              (guix build utils)))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build utils)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette
+             (list (string-append #$qemu-minimal "/bin/" (qemu-command))
+                   #$@(common-qemu-options (system-image test-image) '()
+                                           #:image-format "qcow2"
+                                           #:rw-image? #t)
+                   "-m" "512"
+                   "-nographic" "-serial" "stdio"
+                   "-snapshot")))
+
+          (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))
+
+          (test-end))))
+
+  (gexp->derivation "guix-daemon-test" test))
+
+(define %test-guix-daemon
+  (system-test
+   (name "guix-daemon")
+   (description
+    "Test 'guix-daemon' behavior on a multi-user system.")
+   (value
+    (let ((os (marionette-operating-system
+               (operating-system
+                 (inherit (operating-system-with-gc-roots
+                           %simple-os
+                           (list (profile
+                                  (name "hello-build-dependencies")
+                                  (content %hello-dependencies-manifest)))))
+                 (kernel-arguments '("console=ttyS0"))
+                 (users (cons (user-account
+                               (name "user")
+                               (group "users"))
+                              %base-user-accounts)))
+               #:imported-modules '((gnu services herd)
+                                    (guix combinators)))))
+      (run-guix-daemon-test os)))))
-- 
2.48.1

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#76636] [PATCH 4/5] tests: Factorize =?UTF-8?Q?=E2=80=98%hello-dependencies-manifest=E2=80=99.?=
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 28 Feb 2025 10:06:04 +0000
Resent-Message-ID: <handler.76636.B76636.17407371325254 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 76636
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 76636 <at> debbugs.gnu.org
Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Received: via spool by 76636-submit <at> debbugs.gnu.org id=B76636.17407371325254
          (code B ref 76636); Fri, 28 Feb 2025 10:06:04 +0000
Received: (at 76636) by debbugs.gnu.org; 28 Feb 2025 10:05:32 +0000
Received: from localhost ([127.0.0.1]:45369 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tnxFL-0001Mg-Dz
	for submit <at> debbugs.gnu.org; Fri, 28 Feb 2025 05:05:31 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10]:48072)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <ludo@HIDDEN>) id 1tnxFB-0001Ka-9K
 for 76636 <at> debbugs.gnu.org; Fri, 28 Feb 2025 05:05:25 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <ludo@HIDDEN>)
 id 1tnxF5-0000KY-VU; Fri, 28 Feb 2025 05:05:15 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To:
 From; bh=m1uEZM6XXlCQrDi9/s/CwLH4H2k+qPpdwRRRmjqqZ4s=; b=jl2Vj4ka5Tj6g7SN3l4g
 WHw4u+umZ0+FHZJae2JbdOhFW5Hb4lI+wQykPF9tQ3uMrAIf1bbinVIMjtg70Xdj06PG2iad0YwWm
 hUTK+u9YNuxSfPoWGgLUv0ROKEqj/7CSYNlleGkcF1t63GmTRRhSoi5leczvzt93ZTWy2rFlZfCph
 gkpevlJ+Lm8Pi98gQODi0iczFg42o1bbvsMzlatxmYnYDFwZGju6L+teoxZNsWNpik+Gx713R7QjC
 P3hSJE/xBKbOZzWplyVvnbYLMah4KbYvoYwUUuUrXSole4Fcwghm1+/oWnJxo+vXI04908GHbccKQ
 mNZeUfaI37hrBQ==;
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Date: Fri, 28 Feb 2025 11:04:31 +0100
Message-ID: <e7072155f14527e7c055b523c42294d0fc55de66.1740736327.git.ludo@HIDDEN>
X-Mailer: git-send-email 2.48.1
In-Reply-To: <cover.1740736327.git.ludo@HIDDEN>
References: <cover.1740736327.git.ludo@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -2.3 (--)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

* gnu/tests/base.scm (%hello-dependencies-manifest): Export.
* gnu/tests/foreign.scm (%installation-tarball-manifest): Use it.

Change-Id: Id92232f479ab5d1f0c48036b0546e3745aa63e52
---
 gnu/tests/base.scm    |  4 +++-
 gnu/tests/foreign.scm | 36 +++---------------------------------
 2 files changed, 6 insertions(+), 34 deletions(-)

diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 38bd1e687fc..f2122d7d0a5 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -60,6 +60,8 @@ (define-module (gnu tests base)
             %test-root-unmount
             %test-cleanup
             %test-activation
+
+            %hello-dependencies-manifest
             %test-guix-daemon))
 
 (define %simple-os
@@ -998,7 +1000,7 @@ (define (manifest-entry-without-grafts entry)
     (item (with-parameters ((%graft? #f))
             (manifest-entry-item entry)))))
 
-(define %hello-dependencies-manifest            ;TODO: Share with (gnu tests foreign).
+(define %hello-dependencies-manifest
   ;; Build dependencies of 'hello' needed to test 'guix build hello'.
   (concatenate-manifests
    (list (map-manifest-entries
diff --git a/gnu/tests/foreign.scm b/gnu/tests/foreign.scm
index a08622424a7..9aba803c4d8 100644
--- a/gnu/tests/foreign.scm
+++ b/gnu/tests/foreign.scm
@@ -26,6 +26,8 @@ (define-module (gnu tests foreign)
   #:autoload   (guix store) (%store-prefix %store-monad %graft?)
   #:use-module (gnu compression)
   #:use-module (gnu tests)
+  #:use-module ((gnu tests base)
+                #:select (%hello-dependencies-manifest))
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootstrap)
   #:use-module (gnu packages guile)
@@ -140,39 +142,7 @@ (define %installation-tarball-manifest
   ;; Manifest of the Guix installation tarball.
   (concatenate-manifests
    (list (packages->manifest (list guix))
-
-         ;; Include the dependencies of 'hello' in addition to 'guix' so that
-         ;; we can test 'guix build hello'.
-         (map-manifest-entries
-          manifest-entry-without-grafts
-          (package->development-manifest hello))
-
-         ;; Add the source of 'hello'.
-         (manifest
-          (list (manifest-entry
-                  (name "hello-source")
-                  (version (package-version hello))
-                  (item (let ((file (origin-actual-file-name
-                                     (package-source hello))))
-                          (computed-file
-                           "hello-source"
-                           #~(begin
-                               ;; Put the tarball in a subdirectory since
-                               ;; profile union crashes otherwise.
-                               (mkdir #$output)
-                               (mkdir (in-vicinity #$output "src"))
-                               (symlink #$(package-source hello)
-                                        (in-vicinity #$output
-                                                     (string-append "src/"
-                                                                    #$file))))))))))
-
-         ;; Include 'guile-final', which is needed when building derivations
-         ;; such as that of 'hello' but missing from the development manifest.
-         ;; Add '%bootstrap-guile', used by 'guix install --bootstrap'.
-         (map-manifest-entries
-          manifest-entry-without-grafts
-          (packages->manifest (list (canonical-package guile-3.0)
-                                    %bootstrap-guile))))))
+         %hello-dependencies-manifest)))
 
 (define %guix-install-script
   ;; The 'guix-install.sh' script.
-- 
2.48.1

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#76636] [PATCH 5/5] tests: Factorize =?UTF-8?Q?=E2=80=98guix-daemon=E2=80=99?= test cases.
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 28 Feb 2025 10:07:02 +0000
Resent-Message-ID: <handler.76636.B76636.17407371765510 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 76636
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 76636 <at> debbugs.gnu.org
Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Received: via spool by 76636-submit <at> debbugs.gnu.org id=B76636.17407371765510
          (code B ref 76636); Fri, 28 Feb 2025 10:07:02 +0000
Received: (at 76636) by debbugs.gnu.org; 28 Feb 2025 10:06:16 +0000
Received: from localhost ([127.0.0.1]:45379 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tnxG3-0001Qm-PH
	for submit <at> debbugs.gnu.org; Fri, 28 Feb 2025 05:06:16 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10]:47084)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <ludo@HIDDEN>) id 1tnxFJ-0001Lj-Ie
 for 76636 <at> debbugs.gnu.org; Fri, 28 Feb 2025 05:05:30 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <ludo@HIDDEN>)
 id 1tnxFE-0000LX-3S; Fri, 28 Feb 2025 05:05:24 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To:
 From; bh=lwuQYiTpeZi7OItVNgMQD3X3hOHjZylSlYKGfYSLZt8=; b=qUwJQUTOnRFAU9oWNizh
 JQyY/ZUgq2MjciplcN8jp4N0jKglMro1h2Uj/yQqZh9as0qajvwJNU8AeL1gRjVfLJ3pZ9994mt0n
 5pByP2T8XD0JQVRR9XlLt2dNkL4KmLMpQ8uiJdSRfpsfiQIw1FeP9IJExtgH/onMjiOtT5UHtlEQ1
 kpcqZ0+fQmAKgD52rrQLO2OkdvsOIHkACwOJRFBjt8P38h3VXhH1hnJdoDSshhREYxvGnIZLNZo/I
 vDVygTS4gGjNoTxWmwXUULYmSqJcf6SQX+BjPpX3H9xa4g3+yIcdTtzCpq51Wzj/j1Wnf13//OCzp
 MxaKL3bxg24e7g==;
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Date: Fri, 28 Feb 2025 11:04:32 +0100
Message-ID: <15770d6384520d287f96d53047c799bfe51b6624.1740736327.git.ludo@HIDDEN>
X-Mailer: git-send-email 2.48.1
In-Reply-To: <cover.1740736327.git.ludo@HIDDEN>
References: <cover.1740736327.git.ludo@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -2.3 (--)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

* 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

Message received at control <at> debbugs.gnu.org:

Received: (at control) by debbugs.gnu.org; 28 Feb 2025 10:07:31 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Feb 28 05:07:31 2025
Received: from localhost ([127.0.0.1]:45394 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tnxHG-0001Wx-Nd
	for submit <at> debbugs.gnu.org; Fri, 28 Feb 2025 05:07:30 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10]:53268)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <ludo@HIDDEN>) id 1tnxHE-0001WN-F7
 for control <at> debbugs.gnu.org; Fri, 28 Feb 2025 05:07:28 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <ludo@HIDDEN>) id 1tnxH6-0000bj-EN
 for control <at> debbugs.gnu.org; Fri, 28 Feb 2025 05:07:23 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=MIME-version:Subject:From:To:Date:in-reply-to:
 references; bh=gk4nVFppcMOFqHbVyyhlf0k/BH/+EaLhJ5zqP7d+xZI=; b=fMzUJdtcE1M5ls
 zaVnX0HbbPLPLUdEoOLIhzPAKHBjdeIUFCh+KK+xmFHp2osFZvtYIL35QhvsJEDyLX5zVo4kJ6Ky/
 ditsExXU3eH71msgB/ASm7sPn6XZeAwyZalVMAHHa3pJ8h7RThKovEgfikiWcgk5C5wYzO+zVX6cG
 0BFPglkqwTNhSUz3ut7Kq0APpjUvRrASjftNk//Si1naW6LaKhSNcVIfK0jwGDK03sSrlFJDGzJlC
 w8HENUA71GIYYQuuF7A3OXwIXVRgVbUt6T8GcPYqvsy27HROe3S8IIb1gJVjH7DfMhxLv57C6Pfca
 6jIhnOwNGTIaMSj+zKoA==;
Date: Fri, 28 Feb 2025 11:07:13 +0100
Message-Id: <87o6ymtmb2.fsf@HIDDEN>
To: control <at> debbugs.gnu.org
From: =?utf-8?Q?Ludovic_Court=C3=A8s?= <ludo@HIDDEN>
Subject: control message for bug #76636
MIME-version: 1.0
Content-type: text/plain; charset=utf-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: control
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

block 76636 by 76488
quit

Last modified: Fri, 28 Feb 2025 10:15:01 UTC

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