ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-23 21:17:11 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix build: Accept multiple '-s' options.

Browse source 
* guix/scripts/build.scm (%default-options): Remove 'system'.
(%options) <--system>: Keep previous occurrences of 'system in RESULT.
(options->derivations)[system]: Remove.
[systems, things-to-build]: New variables.
[compute-derivation]: New procedure.
Iterate on all of SYSTEMS to compute the derivations of THINGS-TO-BUILD.
* tests/guix-build.sh: Add test for one and multiple '-s' flags.
* doc/guix.texi (Additional Build Options): Document this behavior.
This commit is contained in:
Ludovic Courtès 2019-04-19 15:18:20 +02:00
parent 296da6e624
commit ea261dea0c
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 70 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
doc/guix.texi
View file

@ -8030,7 +8030,9 @@ The following derivations will be built:
@item --system=@var{system}
@itemx -s @var{system}
Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of
the system type of the build host.
the system type of the build host. The @command{guix build} command allows
you to repeat this option several times, in which case it builds for all the
specified systems; other commands ignore extraneous @option{-s} options.
@quotation Note
The @code{--system} flag is for @emph{native} compilation and must not

107
guix/scripts/build.scm
View file

@ -635,8 +635,7 @@ (define %standard-build-options
(define %default-options
;; Alist of default option values.
`((system . ,(%current-system))
(build-mode . ,(build-mode normal))
`((build-mode . ,(build-mode normal))
(graft? . #t)
(substitutes? . #t)
(build-hook? . #t)
@ -729,8 +728,7 @@ (define %options
rest)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
(alist-cons 'system arg result)))
(option '("target") #t #f
(lambda (opt name arg result)
(alist-cons 'target arg
@ -811,56 +809,71 @@ (define package->derivation
(cut package-cross-derivation <> <> triplet <>))))
(define src (assoc-ref opts 'source))
(define system (assoc-ref opts 'system))
(define graft? (assoc-ref opts 'graft?))
(define systems
(match (filter-map (match-lambda
(('system . system) system)
(_ #f))
opts)
(() (list (%current-system)))
(systems systems)))
(define things-to-build
(map (cut transform store <>)
(options->things-to-build opts)))
(define (compute-derivation obj system)
;; Compute the derivation of OBJ for SYSTEM.
(match obj
((? package? p)
(let ((p (or (and graft? (package-replacement p)) p)))
(match src
(#f
(list (package->derivation store p system)))
(#t
(match (package-source p)
(#f
(format (current-error-port)
(G_ "~a: warning: \
package '~a' has no source~%")
(location->string (package-location p))
(package-name p))
'())
(s
(list (package-source-derivation store s)))))
(proc
(map (cut package-source-derivation store <>)
(proc p))))))
((? derivation? drv)
(list drv))
((? procedure? proc)
(list (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(proc))
#:system system)))
((? file-like? obj)
(list (run-with-store store
(lower-object obj system
#:target (assoc-ref opts 'target))
#:system system)))
((? gexp? gexp)
(list (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(gexp->derivation "gexp" gexp
#:system system))
#:system system)))))
;; We may get 'unbound-variable' errors while evaluating the 'inputs' fields
;; of user packages. Since 'guix build' is the primary tool for people
;; testing new packages, report such errors gracefully.
(with-unbound-variable-handling
(parameterize ((%graft? graft?))
(append-map (match-lambda
((? package? p)
(let ((p (or (and graft? (package-replacement p)) p)))
(match src
(#f
(list (package->derivation store p system)))
(#t
(match (package-source p)
(#f
(format (current-error-port)
(G_ "~a: warning: \
package '~a' has no source~%")
(location->string (package-location p))
(package-name p))
'())
(s
(list (package-source-derivation store s)))))
(proc
(map (cut package-source-derivation store <>)
(proc p))))))
((? derivation? drv)
(list drv))
((? procedure? proc)
(list (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(proc))
#:system system)))
((? file-like? obj)
(list (run-with-store store
(lower-object obj system
#:target (assoc-ref opts 'target))
#:system system)))
((? gexp? gexp)
(list (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(gexp->derivation "gexp" gexp
#:system system))
#:system system))))
(map (cut transform store <>)
(options->things-to-build opts))))))
(append-map (lambda (system)
(append-map (cut compute-derivation <> system)
things-to-build))
systems))))
(define (show-build-log store file urls)
"Show the build log for FILE, falling back to remote logs from URLS if

7
tests/guix-build.sh
View file

@ -44,6 +44,13 @@ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'
guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'; \
then exit 1; fi )
# Passing one '-s' flag.
test `guix build sed -s x86_64-linux -d | wc -l` = 1
# Passing multiple '-s' flags.
all_systems="-s x86_64-linux -s i686-linux -s armhf-linux -s aarch64-linux"
test `guix build sed $all_systems -d | sort -u | wc -l` = 4
# Check --sources option with its arguments
module_dir="t-guix-build-$$"
mkdir "$module_dir"