pack: Honor package transformation options.

Previously they would silently be ignored.

* guix/scripts/pack.scm (guix-pack)[manifest-from-args]: Add 'store'
parameter.  Call 'options->transformation' and use it.
Move 'with-store' and 'parameterize' around the 'let'.
* tests/guix-pack.sh: Add test using '--with-source'.
This commit is contained in:
Ludovic Courtès 2018-05-07 10:44:18 +02:00 committed by Ludovic Courtès
parent df6f86a0cb
commit aad16cc196
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 44 additions and 30 deletions

View File

@ -43,6 +43,7 @@
#:autoload (gnu packages guile) (guile2.0-json guile-json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (compressor?
@ -397,9 +398,14 @@ Create a bundle of PACKAGE.\n"))
(read/eval-package-expression exp))
(x #f)))
(define (manifest-from-args opts)
(let ((packages (filter-map maybe-package-argument opts))
(manifest-file (assoc-ref opts 'manifest)))
(define (manifest-from-args store opts)
(let* ((transform (options->transformation opts))
(packages (map (match-lambda
(((? package? package) output)
(list (transform store package)
output)))
(filter-map maybe-package-argument opts)))
(manifest-file (assoc-ref opts 'manifest)))
(cond
((and manifest-file (not (null? packages)))
(leave (G_ "both a manifest and a package list were given~%")))
@ -409,33 +415,34 @@ Create a bundle of PACKAGE.\n"))
(else (packages->manifest packages)))))
(with-error-handling
(let* ((dry-run? (assoc-ref opts 'dry-run?))
(manifest (manifest-from-args opts))
(pack-format (assoc-ref opts 'format))
(name (string-append (symbol->string pack-format)
"-pack"))
(target (assoc-ref opts 'target))
(bootstrap? (assoc-ref opts 'bootstrap?))
(compressor (if bootstrap?
bootstrap-xz
(assoc-ref opts 'compressor)))
(tar (if bootstrap?
%bootstrap-coreutils&co
tar))
(symlinks (assoc-ref opts 'symlinks))
(build-image (match (assq-ref %formats pack-format)
((? procedure? proc) proc)
(#f
(leave (G_ "~a: unknown pack format")
format))))
(localstatedir? (assoc-ref opts 'localstatedir?)))
(with-store store
(parameterize ((%graft? (assoc-ref opts 'graft?))
(%guile-for-build (package-derivation
store
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(canonical-package guile-2.2)))))
(with-store store
(parameterize ((%graft? (assoc-ref opts 'graft?))
(%guile-for-build (package-derivation
store
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
(canonical-package guile-2.2))
#:graft? (assoc-ref opts 'graft?))))
(let* ((dry-run? (assoc-ref opts 'dry-run?))
(manifest (manifest-from-args store opts))
(pack-format (assoc-ref opts 'format))
(name (string-append (symbol->string pack-format)
"-pack"))
(target (assoc-ref opts 'target))
(bootstrap? (assoc-ref opts 'bootstrap?))
(compressor (if bootstrap?
bootstrap-xz
(assoc-ref opts 'compressor)))
(tar (if bootstrap?
%bootstrap-coreutils&co
tar))
(symlinks (assoc-ref opts 'symlinks))
(build-image (match (assq-ref %formats pack-format)
((? procedure? proc) proc)
(#f
(leave (G_ "~a: unknown pack format")
format))))
(localstatedir? (assoc-ref opts 'localstatedir?)))
;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts)

View File

@ -83,3 +83,10 @@ guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
# Build a tarball pack of cross-compiled software. Use coreutils because
# guile-bootstrap is not intended to be cross-compiled.
guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils
# Make sure package transformation options are honored.
mkdir -p "$test_directory"
drv1="`guix pack -n guile 2>&1 | grep pack.*\.drv`"
drv2="`guix pack -n --with-source=guile=$test_directory guile 2>&1 | grep pack.*\.drv`"
test -n "$drv1"
test "$drv1" != "$drv2"