mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-18 13:36:36 +01:00
guix build: Add ‘--development’ option.
* guix/scripts/build.scm (show-help, %options): Add ‘-D’. (options->things-to-build): Change ‘append-map’ to a loop. Honor ‘-D’. * tests/guix-build.sh: Add test. * doc/guix.texi (Additional Build Options): Document it. Reviewed-by: Maxim Cournoyer <maxim.cournoyer@gmail.com> Change-Id: I99227aadfe861e43c001a4872292bd687b37f5d4
This commit is contained in:
parent
bc3c89a475
commit
a633422371
3 changed files with 112 additions and 37 deletions
|
@ -13614,6 +13614,31 @@ Lastly, @var{expr} may refer to a zero-argument monadic procedure
|
|||
(@pxref{The Store Monad}). The procedure must return a derivation as a
|
||||
monadic value, which is then passed through @code{run-with-store}.
|
||||
|
||||
@item --development
|
||||
@itemx -D
|
||||
Build the ``development environment'' (build dependencies) of the
|
||||
following package.
|
||||
|
||||
For example, the following command builds the inputs of @code{hello},
|
||||
but @emph{not} @code{hello} itself, and also builds @code{guile}:
|
||||
|
||||
@example
|
||||
guix build -D hello guile
|
||||
@end example
|
||||
|
||||
Notice that @option{-D} (or @option{--development}) only applies to the
|
||||
immediately following package on the command line. Under the hood, it
|
||||
uses @code{package->development-manifest}
|
||||
(@pxref{package-development-manifest,
|
||||
@code{package->development-manifest}}).
|
||||
|
||||
@quotation Note
|
||||
The effect of combining @option{--development} with @option{--target}
|
||||
(for cross-compilation) may not be what you expect: it will
|
||||
cross-compile all the dependencies of the given package when it is built
|
||||
natively.
|
||||
@end quotation
|
||||
|
||||
@item --source
|
||||
@itemx -S
|
||||
Build the source derivations of the packages, rather than the packages
|
||||
|
|
|
@ -438,6 +438,8 @@ (define (show-help)
|
|||
-m, --manifest=FILE build the packages that the manifest given in FILE
|
||||
evaluates to"))
|
||||
(display (G_ "
|
||||
-D, --development build the inputs of the following package"))
|
||||
(display (G_ "
|
||||
-S, --source build the packages' source derivations"))
|
||||
(display (G_ "
|
||||
--sources[=TYPE] build source derivations; TYPE may optionally be one
|
||||
|
@ -522,6 +524,9 @@ (define %options
|
|||
(option '(#\m "manifest") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'manifest arg result)))
|
||||
(option '(#\D "development") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'development? #t result)))
|
||||
(option '(#\n "dry-run") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'dry-run? #t result)))
|
||||
|
@ -581,43 +586,83 @@ (define (ensure-list x)
|
|||
(for-each validate-type lst)
|
||||
lst))
|
||||
|
||||
(append-map (match-lambda
|
||||
(('argument . (? string? spec))
|
||||
(cond ((derivation-path? spec)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
;; Ask for absolute file names so that .drv file
|
||||
;; names passed from the user to 'read-derivation'
|
||||
;; are absolute when it returns.
|
||||
(let ((spec (canonicalize-path spec)))
|
||||
(list (read-derivation-from-file spec))))
|
||||
(lambda args
|
||||
;; Non-existent .drv files can be substituted down
|
||||
;; the road, so don't error out.
|
||||
(if (= ENOENT (system-error-errno args))
|
||||
'()
|
||||
(apply throw args)))))
|
||||
((store-path? spec)
|
||||
;; Nothing to do; maybe for --log-file.
|
||||
'())
|
||||
(else
|
||||
(list (specification->package spec)))))
|
||||
(('file . file)
|
||||
(let ((file (or (and (string-suffix? ".json" file)
|
||||
(json->scheme-file file))
|
||||
file)))
|
||||
(ensure-list (load* file (make-user-module '())))))
|
||||
(('manifest . manifest)
|
||||
(map manifest-entry-item
|
||||
(manifest-entries
|
||||
(load* manifest
|
||||
(make-user-module '((guix profiles) (gnu)))))))
|
||||
(('expression . str)
|
||||
(ensure-list (read/eval str)))
|
||||
(('argument . (? derivation? drv))
|
||||
drv)
|
||||
(_ '()))
|
||||
opts))
|
||||
(define system
|
||||
(or (assoc-ref opts 'system) (%current-system)))
|
||||
|
||||
;; Process OPTS in "the right order", meaning that if the user typed
|
||||
;; "-D hello", arrange to see the 'development? option before the "hello"
|
||||
;; spec.
|
||||
(let loop ((opts (reverse opts))
|
||||
(type 'regular)
|
||||
(result '()))
|
||||
(define (for-type obj)
|
||||
;; Return a list of objects corresponding to OBJ adjusted for TYPE.
|
||||
(match type
|
||||
('regular
|
||||
(list obj))
|
||||
('development
|
||||
(if (package? obj)
|
||||
(map manifest-entry-item
|
||||
(manifest-entries
|
||||
(package->development-manifest obj system)))
|
||||
obj))))
|
||||
|
||||
(match opts
|
||||
(()
|
||||
(reverse result))
|
||||
((head . tail)
|
||||
(match head
|
||||
(('argument . (? string? spec))
|
||||
(cond ((derivation-path? spec)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
;; Ask for absolute file names so that .drv file
|
||||
;; names passed from the user to 'read-derivation'
|
||||
;; are absolute when it returns.
|
||||
(let ((spec (canonicalize-path spec)))
|
||||
(loop tail 'regular
|
||||
(cons (read-derivation-from-file spec)
|
||||
result))))
|
||||
(lambda args
|
||||
;; Non-existent .drv files can be substituted down
|
||||
;; the road, so don't error out.
|
||||
(if (= ENOENT (system-error-errno args))
|
||||
(loop tail 'regular result)
|
||||
(apply throw args)))))
|
||||
((store-path? spec)
|
||||
;; Nothing to do; maybe for --log-file.
|
||||
(loop tail type result))
|
||||
(else
|
||||
(loop tail 'regular
|
||||
(append (for-type (specification->package spec))
|
||||
result)))))
|
||||
(('argument . (? derivation? drv))
|
||||
(loop tail 'regular (cons drv result)))
|
||||
(('file . file)
|
||||
(let ((file (or (and (string-suffix? ".json" file)
|
||||
(json->scheme-file file))
|
||||
file)))
|
||||
(loop tail 'regular
|
||||
(append (append-map
|
||||
for-type
|
||||
(ensure-list (load* file (make-user-module '()))))
|
||||
result))))
|
||||
(('manifest . manifest)
|
||||
(loop tail 'regular
|
||||
(append (map manifest-entry-item
|
||||
(manifest-entries
|
||||
(load* manifest
|
||||
(make-user-module '((guix profiles)
|
||||
(gnu))))))
|
||||
result)))
|
||||
(('expression . str)
|
||||
(loop tail 'regular
|
||||
(append (append-map for-type (ensure-list (read/eval str)))
|
||||
result)))
|
||||
(('development? . #t)
|
||||
(loop tail 'development result))
|
||||
(_
|
||||
(loop tail type result)))))))
|
||||
|
||||
(define (options->derivations store opts)
|
||||
"Given OPTS, the result of 'args-fold', return a list of derivations to
|
||||
|
|
|
@ -190,6 +190,11 @@ test `guix build -d --sources=transitive foo \
|
|||
| grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \
|
||||
| wc -l` -eq 3
|
||||
|
||||
# Building the inputs.
|
||||
guix build -D hello -n
|
||||
test `guix build -D hello -d \
|
||||
| grep -e 'glibc.*\.drv$' -e 'gcc.*\.drv$' -e 'binutils.*\.drv$' \
|
||||
| wc -l` -ge 3
|
||||
|
||||
# Unbound variable in thunked field.
|
||||
cat > "$module_dir/foo.scm" <<EOF
|
||||
|
|
Loading…
Reference in a new issue