Subject: bug#76850: [PATCH] tests: pack: Fix nondeterministic AppImage tests.

From: Noé Lopez <[email-masked]>
Date: Sun, 6 Apr 2025 00:31:47 +0200

As reported in #76850, the tested AppImages were not actually relocatable and
would rely on items being available on the environment’s store (apart from
glibc).

* guix/scripts/pack.scm (wrapped-manifest): New function.
(guix-pack): Extract relocatable manifest to wrapped-manifest.
* tests/pack.scm: Use relocatable profiles in AppImage tests.

Change-Id: Ib3123054913fce903d215dc0629d806e9fceebc7
---
 guix/scripts/pack.scm | 11 ++++++++---
 tests/pack.scm        |  8 ++++++--
 2 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 7ab2c0d447..c0b7216921 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -1406,6 +1406,13 @@ (define (wrapped-manifest-entry entry . args)
                          (apply wrapped-manifest-entry entry args))
                        (manifest-entry-dependencies entry)))))
 
+(define*-public (wrapped-manifest manifest #:rest args)
+  "Return the MANIFEST with its entries wrapped such that they are
+relocatable. Extra arguments are passed to wrapped-package."
+  (map-manifest-entries
+   (lambda (entry) (apply wrapped-manifest-entry entry args))
+   manifest))
+
 
 ;;;
 ;;; Command-line options.
@@ -1801,9 +1808,7 @@ (define-command (guix-pack . args)
                                   ;; Note: We cannot honor '--bootstrap' here because
                                   ;; 'glibc-bootstrap' lacks 'libc.a'.
                                   (if relocatable?
-                                      (map-manifest-entries
-                                       (cut wrapped-manifest-entry <> #:proot? proot?)
-                                       manifest)
+                                      (wrapped-manifest manifest #:proot? proot?)
                                       manifest)))
                    (pack-format (assoc-ref opts 'format))
                    (extra-options (match pack-format
diff --git a/tests/pack.scm b/tests/pack.scm
index 9c7e0a50ba..1d1aef024f 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -350,7 +350,9 @@ (define rpm-for-tests
          (profile -> (profile
                       ;; When using '--appimage-extract-and-run', the dynamic
                       ;; linker is necessary, hence glibc below.
-                      (content (packages->manifest (list hello glibc)))
+                      (content (wrapped-manifest
+                                (packages->manifest (list hello glibc))))
+                      (relative-symlinks? #t)
                       (hooks '())
                       (locales? #f)))
          (image   (self-contained-appimage "hello-appimage" profile
@@ -382,7 +384,9 @@ (define rpm-for-tests
          (profile -> (profile
                       ;; When using '--appimage-extract-and-run', the dynamic
                       ;; linker is necessary, hence glibc below.
-                      (content (packages->manifest (list guile-3.0 glibc)))
+                      (content (wrapped-manifest
+                                (packages->manifest (list guile-3.0 glibc))))
+                      (relative-symlinks? #t)
                       (hooks '())
                       (locales? #f)))
          (image   (self-contained-appimage "guile-appimage" profile

base-commit: 80826c6e038997dc47eb455888f0feaa38c08bf5
-- 
2.49.0