ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 21:59:08 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

pack: Honor package transformation options.

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

67
guix/scripts/pack.scm
View file

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

7
tests/guix-pack.sh
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 # Build a tarball pack of cross-compiled software. Use coreutils because
# guile-bootstrap is not intended to be cross-compiled. # guile-bootstrap is not intended to be cross-compiled.
guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils 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"