summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/scripts/pack.scm17
-rw-r--r--tests/pack.scm26
2 files changed, 27 insertions, 16 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index f46abc44d62..0b78f07077b 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -11,7 +11,7 @@
11;;; Copyright © 2023 Graham James Addis <graham@addis.org.uk> 11;;; Copyright © 2023 Graham James Addis <graham@addis.org.uk>
12;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com> 12;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
13;;; Copyright © 2024 Sebastian Dümcke <code@sam-d.com> 13;;; Copyright © 2024 Sebastian Dümcke <code@sam-d.com>
14;;; Copyright © 2024 Noé Lopez <noelopez@free.fr> 14;;; Copyright © 2024-2025 Noé Lopez <noelopez@free.fr>
15;;; 15;;;
16;;; This file is part of GNU Guix. 16;;; This file is part of GNU Guix.
17;;; 17;;;
@@ -81,7 +81,9 @@
81 self-contained-appimage 81 self-contained-appimage
82 82
83 %formats 83 %formats
84 guix-pack)) 84 guix-pack
85
86 wrapped-manifest))
85 87
86;;; Commentary: 88;;; Commentary:
87 89
@@ -1397,6 +1399,13 @@ libfakechroot.so and related ld.so machinery as a fallback."
1397 (apply wrapped-manifest-entry entry args)) 1399 (apply wrapped-manifest-entry entry args))
1398 (manifest-entry-dependencies entry))))) 1400 (manifest-entry-dependencies entry)))))
1399 1401
1402(define* (wrapped-manifest manifest #:rest args)
1403 "Return the MANIFEST with its entries wrapped such that they are
1404relocatable. Extra arguments are passed to wrapped-package."
1405 (map-manifest-entries
1406 (lambda (entry) (apply wrapped-manifest-entry entry args))
1407 manifest))
1408
1400 1409
1401;;; 1410;;;
1402;;; Command-line options. 1411;;; Command-line options.
@@ -1795,9 +1804,7 @@ Create a bundle of PACKAGE.\n"))
1795 ;; Note: We cannot honor '--bootstrap' here because 1804 ;; Note: We cannot honor '--bootstrap' here because
1796 ;; 'glibc-bootstrap' lacks 'libc.a'. 1805 ;; 'glibc-bootstrap' lacks 'libc.a'.
1797 (if relocatable? 1806 (if relocatable?
1798 (map-manifest-entries 1807 (wrapped-manifest manifest #:proot? proot?)
1799 (cut wrapped-manifest-entry <> #:proot? proot?)
1800 manifest)
1801 manifest))) 1808 manifest)))
1802 (pack-format (assoc-ref opts 'format)) 1809 (pack-format (assoc-ref opts 'format))
1803 (extra-options (match pack-format 1810 (extra-options (match pack-format
diff --git a/tests/pack.scm b/tests/pack.scm
index d0a1b72eb94..5422e156b90 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -3,7 +3,7 @@
3;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> 3;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
4;;; Copyright © 2021, 2023, 2025 Maxim Cournoyer <maxim@guixotic.coop> 4;;; Copyright © 2021, 2023, 2025 Maxim Cournoyer <maxim@guixotic.coop>
5;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com> 5;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
6;;; Copyright © 2024 Noé Lopez <noelopez@free.fr> 6;;; Copyright © 2024-2025 Noé Lopez <noelopez@free.fr>
7;;; 7;;;
8;;; This file is part of GNU Guix. 8;;; This file is part of GNU Guix.
9;;; 9;;;
@@ -337,11 +337,13 @@
337 (mlet* %store-monad 337 (mlet* %store-monad
338 ((guile (set-guile-for-build (default-guile))) 338 ((guile (set-guile-for-build (default-guile)))
339 (profile -> (profile 339 (profile -> (profile
340 ;; When using '--appimage-extract-and-run', the dynamic 340 ;; When using '--appimage-extract-and-run', the dynamic
341 ;; linker is necessary, hence glibc below. 341 ;; linker is necessary, hence glibc below.
342 (content (packages->manifest (list hello glibc))) 342 (content (wrapped-manifest
343 (hooks '()) 343 (packages->manifest (list hello glibc))))
344 (locales? #f))) 344 (relative-symlinks? #t)
345 (hooks '())
346 (locales? #f)))
345 (image (self-contained-appimage "hello-appimage" profile 347 (image (self-contained-appimage "hello-appimage" profile
346 #:entry-point "bin/hello" 348 #:entry-point "bin/hello"
347 #:extra-options 349 #:extra-options
@@ -369,11 +371,13 @@
369 (mlet* %store-monad 371 (mlet* %store-monad
370 ((guile (set-guile-for-build (default-guile))) 372 ((guile (set-guile-for-build (default-guile)))
371 (profile -> (profile 373 (profile -> (profile
372 ;; When using '--appimage-extract-and-run', the dynamic 374 ;; When using '--appimage-extract-and-run', the dynamic
373 ;; linker is necessary, hence glibc below. 375 ;; linker is necessary, hence glibc below.
374 (content (packages->manifest (list guile-3.0 glibc))) 376 (content (wrapped-manifest
375 (hooks '()) 377 (packages->manifest (list guile-3.0 glibc))))
376 (locales? #f))) 378 (relative-symlinks? #t)
379 (hooks '())
380 (locales? #f)))
377 (image (self-contained-appimage "guile-appimage" profile 381 (image (self-contained-appimage "guile-appimage" profile
378 #:entry-point "bin/guile" 382 #:entry-point "bin/guile"
379 #:localstatedir? #t 383 #:localstatedir? #t