guix build: Accept multiple '-s' options.

* 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

View file

@ -8030,7 +8030,9 @@ The following derivations will be built:
@item --system=@var{system} @item --system=@var{system}
@itemx -s @var{system} @itemx -s @var{system}
Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of 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 @quotation Note
The @code{--system} flag is for @emph{native} compilation and must not The @code{--system} flag is for @emph{native} compilation and must not

View file

@ -635,8 +635,7 @@ (define %standard-build-options
(define %default-options (define %default-options
;; Alist of default option values. ;; Alist of default option values.
`((system . ,(%current-system)) `((build-mode . ,(build-mode normal))
(build-mode . ,(build-mode normal))
(graft? . #t) (graft? . #t)
(substitutes? . #t) (substitutes? . #t)
(build-hook? . #t) (build-hook? . #t)
@ -729,8 +728,7 @@ (define %options
rest))) rest)))
(option '(#\s "system") #t #f (option '(#\s "system") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'system arg (alist-cons 'system arg result)))
(alist-delete 'system result eq?))))
(option '("target") #t #f (option '("target") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'target arg (alist-cons 'target arg
@ -811,56 +809,71 @@ (define package->derivation
(cut package-cross-derivation <> <> triplet <>)))) (cut package-cross-derivation <> <> triplet <>))))
(define src (assoc-ref opts 'source)) (define src (assoc-ref opts 'source))
(define system (assoc-ref opts 'system))
(define graft? (assoc-ref opts 'graft?)) (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 ;; We may get 'unbound-variable' errors while evaluating the 'inputs' fields
;; of user packages. Since 'guix build' is the primary tool for people ;; of user packages. Since 'guix build' is the primary tool for people
;; testing new packages, report such errors gracefully. ;; testing new packages, report such errors gracefully.
(with-unbound-variable-handling (with-unbound-variable-handling
(parameterize ((%graft? graft?)) (parameterize ((%graft? graft?))
(append-map (match-lambda (append-map (lambda (system)
((? package? p) (append-map (cut compute-derivation <> system)
(let ((p (or (and graft? (package-replacement p)) p))) things-to-build))
(match src systems))))
(#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))))))
(define (show-build-log store file urls) (define (show-build-log store file urls)
"Show the build log for FILE, falling back to remote logs from URLS if "Show the build log for FILE, falling back to remote logs from URLS if

View file

@ -44,6 +44,13 @@ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'
guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'; \ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'; \
then exit 1; fi ) 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 # Check --sources option with its arguments
module_dir="t-guix-build-$$" module_dir="t-guix-build-$$"
mkdir "$module_dir" mkdir "$module_dir"