mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
pack: '-R' honors the requested output.
Fixes <https://bugs.gnu.org/36925>. Reported by Jesse Gibbons <jgibbons2357@gmail.com>. * guix/scripts/pack.scm (wrapped-package): Add 'output*' parameter. [build]: Define 'input' and 'target'; use them instead of #$package and #$output, respectively. (wrapped-manifest-entry): New procedure. (map-manifest-entries): Call PROC directly. (guix-pack): Pass WRAPPED-MANIFEST-ENTRY to 'map-manifest-entries'.
This commit is contained in:
parent
d78bc23411
commit
b908fcd8c0
2 changed files with 39 additions and 16 deletions
|
@ -611,8 +611,13 @@ (define (output-file args)
|
|||
;;;
|
||||
|
||||
(define* (wrapped-package package
|
||||
#:optional (compiler (c-compiler))
|
||||
#:optional
|
||||
(output* "out")
|
||||
(compiler (c-compiler))
|
||||
#:key proot?)
|
||||
"Return the OUTPUT of PACKAGE with its binaries wrapped such that they are
|
||||
relocatable. When PROOT? is true, include PRoot in the result and use it as a
|
||||
last resort for relocation."
|
||||
(define runner
|
||||
(local-file (search-auxiliary-file "run-in-namespace.c")))
|
||||
|
||||
|
@ -629,6 +634,14 @@ (define build
|
|||
(ice-9 ftw)
|
||||
(ice-9 match))
|
||||
|
||||
(define input
|
||||
;; The OUTPUT* output of PACKAGE.
|
||||
(ungexp package output*))
|
||||
|
||||
(define target
|
||||
;; The output we are producing.
|
||||
(ungexp output output*))
|
||||
|
||||
(define (strip-store-prefix file)
|
||||
;; Given a file name like "/gnu/store/…-foo-1.2/bin/foo", return
|
||||
;; "/bin/foo".
|
||||
|
@ -648,7 +661,7 @@ (define (build-wrapper program)
|
|||
(("@STORE_DIRECTORY@") (%store-directory)))
|
||||
|
||||
(let* ((base (strip-store-prefix program))
|
||||
(result (string-append #$output "/" base))
|
||||
(result (string-append target "/" base))
|
||||
(proot #$(and proot?
|
||||
#~(string-drop
|
||||
#$(file-append (proot) "/bin/proot")
|
||||
|
@ -667,18 +680,18 @@ (define (build-wrapper program)
|
|||
|
||||
;; Link the top-level files of PACKAGE so that search paths are
|
||||
;; properly defined in PROFILE/etc/profile.
|
||||
(mkdir #$output)
|
||||
(mkdir target)
|
||||
(for-each (lambda (file)
|
||||
(unless (member file '("." ".." "bin" "sbin" "libexec"))
|
||||
(let ((file* (string-append #$package "/" file)))
|
||||
(symlink (relative-file-name #$output file*)
|
||||
(string-append #$output "/" file)))))
|
||||
(scandir #$package))
|
||||
(let ((file* (string-append input "/" file)))
|
||||
(symlink (relative-file-name target file*)
|
||||
(string-append target "/" file)))))
|
||||
(scandir input))
|
||||
|
||||
(for-each build-wrapper
|
||||
(append (find-files #$(file-append package "/bin"))
|
||||
(find-files #$(file-append package "/sbin"))
|
||||
(find-files #$(file-append package "/libexec")))))))
|
||||
(append (find-files (string-append input "/bin"))
|
||||
(find-files (string-append input "/sbin"))
|
||||
(find-files (string-append input "/libexec")))))))
|
||||
|
||||
(computed-file (string-append
|
||||
(cond ((package? package)
|
||||
|
@ -691,14 +704,18 @@ (define (build-wrapper program)
|
|||
"R")
|
||||
build))
|
||||
|
||||
(define (wrapped-manifest-entry entry . args)
|
||||
(manifest-entry
|
||||
(inherit entry)
|
||||
(item (apply wrapped-package
|
||||
(manifest-entry-item entry)
|
||||
(manifest-entry-output entry)
|
||||
args))))
|
||||
|
||||
(define (map-manifest-entries proc manifest)
|
||||
"Apply PROC to all the entries of MANIFEST and return a new manifest."
|
||||
(make-manifest
|
||||
(map (lambda (entry)
|
||||
(manifest-entry
|
||||
(inherit entry)
|
||||
(item (proc (manifest-entry-item entry)))))
|
||||
(manifest-entries manifest))))
|
||||
(map proc (manifest-entries manifest))))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -960,7 +977,7 @@ (define properties
|
|||
;; 'glibc-bootstrap' lacks 'libc.a'.
|
||||
(if relocatable?
|
||||
(map-manifest-entries
|
||||
(cut wrapped-package <> #:proot? proot?)
|
||||
(cut wrapped-manifest-entry <> #:proot? proot?)
|
||||
manifest)
|
||||
manifest)))
|
||||
(pack-format (assoc-ref opts 'format))
|
||||
|
|
|
@ -78,3 +78,9 @@ else
|
|||
"$test_directory/Bin/sed" --version > "$test_directory/output"
|
||||
fi
|
||||
grep 'GNU sed' "$test_directory/output"
|
||||
chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
|
||||
|
||||
# Ensure '-R' works with outputs other than "out".
|
||||
tarball="`guix pack -R -S /share=share groff:doc`"
|
||||
(cd "$test_directory"; tar xvf "$tarball")
|
||||
test -d "$test_directory/share/doc/groff/html"
|
||||
|
|
Loading…
Reference in a new issue