aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi4
-rw-r--r--guix/scripts/build.scm107
-rw-r--r--tests/guix-build.sh7
3 files changed, 70 insertions, 48 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 6b713aaf9c..8c7522f286 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index fc0c0e2ad3..ba143ad16b 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -635,8 +635,7 @@ options handled by 'set-build-options-from-command-line', and listed in
(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 @@ must be one of 'package', 'all', or 'transitive'~%")
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 @@ build."
(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
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index d479296ef1..63a9fe68da 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -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"