guix-build: Add `--system'.

* guix-build.in (derivations-from-package-expressions): New `system'
  parameter.  Pass it to `package-derivation'.
  (%default-options): Add `system' pair.
  (show-help): Describe `--system'.
  (%options): Add it.
  (guix-build): Check the `system' pair in OPTS; pass it to
  `derivations-from-package-expressions' and `package-derivation'.
This commit is contained in:
Ludovic Courtès 2012-10-18 23:46:10 +02:00
parent a5a349f302
commit 5cc3061673
1 changed files with 16 additions and 7 deletions

View File

@ -30,6 +30,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module ((guix utils) #:select (%current-system))
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -44,14 +45,14 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
(define %store (define %store
(open-connection)) (open-connection))
(define (derivations-from-package-expressions exp source?) (define (derivations-from-package-expressions exp system source?)
"Eval EXP and return the corresponding derivation path. When SOURCE? is "Eval EXP and return the corresponding derivation path for SYSTEM.
true, return the derivations of the package sources." When SOURCE? is true, return the derivations of the package sources."
(let ((p (eval exp (current-module)))) (let ((p (eval exp (current-module))))
(if (package? p) (if (package? p)
(if source? (if source?
(package-source-derivation %store (package-source p)) (package-source-derivation %store (package-source p))
(package-derivation %store p)) (package-derivation %store p system))
(begin (begin
(format (current-error-port) (format (current-error-port)
(_ "expression `~s' does not evaluate to a package") (_ "expression `~s' does not evaluate to a package")
@ -65,7 +66,7 @@ true, return the derivations of the package sources."
(define %default-options (define %default-options
;; Alist of default option values. ;; Alist of default option values.
'()) `((system . ,(%current-system))))
(define-syntax-rule (leave fmt args ...) (define-syntax-rule (leave fmt args ...)
"Format FMT and ARGS to the error port and exit." "Format FMT and ARGS to the error port and exit."
@ -84,6 +85,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(display (_ " (display (_ "
-S, --source build the packages' source derivations")) -S, --source build the packages' source derivations"))
(display (_ " (display (_ "
-s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
(display (_ "
-d, --derivations return the derivation paths of the given packages")) -d, --derivations return the derivation paths of the given packages"))
(display (_ " (display (_ "
-K, --keep-failed keep build tree of failed builds")) -K, --keep-failed keep build tree of failed builds"))
@ -116,6 +119,10 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
(option '(#\S "source") #f #f (option '(#\S "source") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'source? #t result))) (alist-cons 'source? #t result)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
(option '(#\d "derivations") #f #f (option '(#\d "derivations") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'derivations-only? #t result))) (alist-cons 'derivations-only? #t result)))
@ -162,9 +169,11 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
(let* ((opts (parse-options)) (let* ((opts (parse-options))
(src? (assoc-ref opts 'source?)) (src? (assoc-ref opts 'source?))
(sys (assoc-ref opts 'system))
(drv (filter-map (match-lambda (drv (filter-map (match-lambda
(('expression . exp) (('expression . exp)
(derivations-from-package-expressions exp src?)) (derivations-from-package-expressions exp sys
src?))
(('argument . (? derivation-path? drv)) (('argument . (? derivation-path? drv))
drv) drv)
(('argument . (? string? x)) (('argument . (? string? x))
@ -173,7 +182,7 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
(if src? (if src?
(let ((s (package-source p))) (let ((s (package-source p)))
(package-source-derivation %store s)) (package-source-derivation %store s))
(package-derivation %store p))) (package-derivation %store p sys)))
(_ (_
(leave (_ "~A: unknown package~%") x)))) (leave (_ "~A: unknown package~%") x))))
(_ #f)) (_ #f))