From mboxrd@z Thu Jan 1 00:00:00 1970 From: Eric Bavier Subject: [PATCH 2/2] guix: build: Add transitive source building. Date: Tue, 24 Feb 2015 11:54:01 -0600 Message-ID: <1424800441-21696-2-git-send-email-bavier@member.fsf.org> References: <1424800441-21696-1-git-send-email-bavier@member.fsf.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:60611) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YQJel-00011f-77 for guix-devel@gnu.org; Tue, 24 Feb 2015 12:52:28 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YQJej-0001t8-FC for guix-devel@gnu.org; Tue, 24 Feb 2015 12:52:27 -0500 Received: from mail2.openmailbox.org ([62.4.1.33]:37619) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YQJej-0001st-63 for guix-devel@gnu.org; Tue, 24 Feb 2015 12:52:25 -0500 In-Reply-To: <1424800441-21696-1-git-send-email-bavier@member.fsf.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org * guix/scripts/build.scm (%options): Add --sources option. (package-sources, package-direct-sources) (package-transitive-sources, package-source-derivations): New procedures. (options->derivations)[--sources]: Use them. * doc/guix.texi (Invoking guix build): Document --sources option. * tests/guix-build.sh: Add tests. --- doc/guix.texi | 42 +++++++++++++++++++++++ guix/scripts/build.scm | 88 ++++++++++++++++++++++++++++++++++++++---------- tests/guix-build.sh | 84 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 196 insertions(+), 18 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 0842c91..90d4704 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2757,6 +2757,48 @@ The returned source tarball is the result of applying any patches and code snippets specified in the package's @code{origin} (@pxref{Defining Packages}). +@item --sources +An extension of the @code{--source} option. If a package's source is +patched, this option will cause its unpatched source derivation to also +be built. The @code{--sources} option can accept one of the following +optional argument values: + +@table @code +@item package +This value causes the @code{--sources} option to behave mostly in the +same way as the @code{--source} option. It may additionally build +packages' unpatched source derivations if those exist. + +@item all +Build all packages' source derivations, including any source that might +be listed as @code{inputs}. This is the default value. + +@example +$ guix build --sources tzdata +The following derivations will be built: + /gnu/store/@dots{}-tzdata2014j.tar.gz.drv + /gnu/store/@dots{}-tzcode2014j.tar.gz.drv +@end example + +@item transitive +Build all packages' source derivations, as well as all source +derivations for packages' transitive inputs. This can be used .e.g. to +prefetch package source for later offline building. + +@example +$ guix build --sources=transitive tzdata +The following derivations will be built: + /gnu/store/@dots{}-file-5.22.tar.gz.drv + /gnu/store/@dots{}-findutils-4.4.2.tar.xz.drv + /gnu/store/@dots{}-grep-2.21.tar.xz.drv + /gnu/store/@dots{}-coreutils-8.23.tar.xz.drv + /gnu/store/@dots{}-make-4.1.tar.xz.drv + /gnu/store/@dots{}-bash-4.3.tar.xz.drv +@dots{} +@end example + +@end table + @item --system=@var{system} @itemx -s @var{system} Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 07ced30..4d81b9b 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -228,6 +228,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (display (_ " -S, --source build the packages' source derivations")) (display (_ " + --sources[=TYPE] build source derivations; TYPE may optionally be one + of \"package\", \"all\" (default), or \"transitive\".")) + (display (_ " -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (display (_ " --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) @@ -262,10 +265,22 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (option '(#\V "version") #f #f (lambda args (show-version-and-exit "guix build"))) - (option '(#\S "source") #f #f (lambda (opt name arg result) - (alist-cons 'source? #t result))) + (alist-cons 'source package-sources result))) + (option '("sources") #f #t + (lambda (opt name arg result) + (match arg + ("package" + (alist-cons 'source package-sources result)) + ((or "all" #f) + (alist-cons 'source package-direct-sources result)) + ("transitive" + (alist-cons 'source package-transitive-sources result)) + (else + (leave (_ "invalid argument: '~a' option argument: ~a, ~ +must be one of 'package', 'all', or 'transitive'~%") + name arg))))) (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg @@ -299,6 +314,40 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) %standard-build-options)) +(define (package-sources package) + "Like package-source but returns its results as a list" + (list (package-source package))) + +(define (package-direct-sources package) + "Return all source origins associated with PACKAGE; including origins in +PACKAGE's inputs." + `(,@(or (and=> (package-source package) list) '()) + ,@(filter-map (match-lambda + ((_ (? origin? orig) _ ...) + orig) + (_ #f)) + (package-direct-inputs package)))) + +(define (package-transitive-sources package) + "Return PACKAGE's direct sources, and its input sources, recursively." + (delete-duplicates + (concatenate (filter-map (match-lambda + ((_ (? origin? orig) _ ...) + (list orig)) + ((_ (? package? p) _ ...) + (package-direct-sources p)) + (_ #f)) + (bag-transitive-inputs + (package->bag package)))))) + +(define (package-source-derivations store source) + "Return a list of source derivations for SOURCE. If SOURCE has patches or +snippets to be applied, this list will contain both the patched and unpatched +derivations. Otherwise, this list will contain a single derivation." + (delete-duplicates + (list (package-source-derivation store source #:patched? #f) + (package-source-derivation store source)))) + (define (options->derivations store opts) "Given OPTS, the result of 'args-fold', return a list of derivations to build." @@ -308,28 +357,31 @@ build." (triplet (cut package-cross-derivation <> <> triplet <>)))) - (define src? (assoc-ref opts 'source?)) + (define src (assoc-ref opts 'source)) (define sys (assoc-ref opts 'system)) (define graft? (assoc-ref opts 'graft?)) (parameterize ((%graft? graft?)) (let ((opts (options/with-source store (options/resolve-packages store opts)))) - (filter-map (match-lambda - (('argument . (? package? p)) - (if src? - (let ((s (package-source p))) - (package-source-derivation store s)) - (package->derivation store p sys))) - (('argument . (? derivation? drv)) - drv) - (('argument . (? derivation-path? drv)) - (call-with-input-file drv read-derivation)) - (('argument . (? store-path?)) - ;; Nothing to do; maybe for --log-file. - #f) - (_ #f)) - opts)))) + (concatenate + (filter-map (match-lambda + (('argument . (? package? p)) + (match src + (#f + (list (package->derivation store p sys))) + (proc + (append-map (cut package-source-derivations store <>) + (proc p))))) + (('argument . (? derivation? drv)) + (list drv)) + (('argument . (? derivation-path? drv)) + (list (call-with-input-file drv read-derivation))) + (('argument . (? store-path?)) + ;; Nothing to do; maybe for --log-file. + #f) + (_ #f)) + opts))))) (define (options/resolve-packages store opts) "Return OPTS with package specification strings replaced by actual diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 836c45e..2e58394 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -36,6 +36,90 @@ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' | \ guix build hello -d | \ grep -e '-hello-[0-9\.]\+\.drv$' +# Check --sources option with its arguments +module_dir="t-guix-build-$$" +mkdir "$module_dir" +trap "rm -rf $module_dir" EXIT + +cat > "$module_dir/foo.scm"<