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
