Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Tue, 26 Nov 2024 10:33:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Ludovic Courtès <ludo <at> gnu.org> To: 74542 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org>, Christopher Baines <guix <at> cbaines.net>, Josselin Poiret <dev <at> jpoiret.xyz>, Ludovic Courtès <ludo <at> gnu.org>, Mathieu Othacehe <othacehe <at> gnu.org>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com>, Simon Tournier <zimon.toutoune <at> gmail.com>, Tobias Geerinckx-Rice <me <at> tobias.gr> Subject: [bug#74542] [PATCH v2 04/16] guix build: Add ‘--development’ option. Date: Fri, 29 Nov 2024 10:40:07 +0100
* 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.
Change-Id: I99227aadfe861e43c001a4872292bd687b37f5d4
---
doc/guix.texi | 25 +++++++++
guix/scripts/build.scm | 119 ++++++++++++++++++++++++++++-------------
tests/guix-build.sh | 5 ++
3 files changed, 112 insertions(+), 37 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 26488b41c8..a9d0d044ae 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -13614,6 +13614,31 @@ Additional Build Options
(@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
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 9e05bb532b..e8384c8d2d 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -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-public my-package
(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
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 36eac2b7e0..3637bcdeb3 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -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
--
2.46.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.