From patchwork Wed Mar 13 10:47:49 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 1412 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 0D14316CED; Wed, 13 Mar 2019 11:04:53 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 3B7C216CCC for ; Wed, 13 Mar 2019 11:04:52 +0000 (GMT) Received: from localhost ([127.0.0.1]:42286 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h41gp-0006g8-GV for patchwork@mira.cbaines.net; Wed, 13 Mar 2019 07:04:51 -0400 Received: from eggs.gnu.org ([209.51.188.92]:42807) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h41gh-0006cY-Dn for guix-patches@gnu.org; Wed, 13 Mar 2019 07:04:45 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1h41RX-0000YR-Lp for guix-patches@gnu.org; Wed, 13 Mar 2019 06:49:10 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55791) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1h41RX-0000YG-EL for guix-patches@gnu.org; Wed, 13 Mar 2019 06:49:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1h41RX-0002Qt-As for guix-patches@gnu.org; Wed, 13 Mar 2019 06:49:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#34838] [PATCH 4/6] guix build: Transformation options match packages by spec. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 13 Mar 2019 10:49:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 34838 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 34838@debbugs.gnu.org Received: via spool by 34838-submit@debbugs.gnu.org id=B34838.15524740869250 (code B ref 34838); Wed, 13 Mar 2019 10:49:03 +0000 Received: (at 34838) by debbugs.gnu.org; 13 Mar 2019 10:48:06 +0000 Received: from localhost ([127.0.0.1]:41099 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h41Qb-0002P3-Qy for submit@debbugs.gnu.org; Wed, 13 Mar 2019 06:48:06 -0400 Received: from hera.aquilenet.fr ([185.233.100.1]:38408) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h41QX-0002Nl-Gi for 34838@debbugs.gnu.org; Wed, 13 Mar 2019 06:48:02 -0400 Received: from localhost (localhost [127.0.0.1]) by hera.aquilenet.fr (Postfix) with ESMTP id DBDC3D624; Wed, 13 Mar 2019 11:48:00 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at aquilenet.fr Received: from hera.aquilenet.fr ([127.0.0.1]) by localhost (hera.aquilenet.fr [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id jUHVp3Dlb4o3; Wed, 13 Mar 2019 11:47:58 +0100 (CET) Received: from gnu.org (unknown [IPv6:2a01:e0a:1d:7270:af76:b9b:ca24:c465]) by hera.aquilenet.fr (Postfix) with ESMTPSA id 0CAC8D626; Wed, 13 Mar 2019 11:47:56 +0100 (CET) From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 13 Mar 2019 11:47:49 +0100 Message-Id: <20190313104751.20758-4-ludo@gnu.org> X-Mailer: git-send-email 2.21.0 In-Reply-To: <20190313104751.20758-1-ludo@gnu.org> References: <20190313104751.20758-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches From: Ludovic Courtès This allows us to combine several transformations on a given package, in particular '--with-git-url' and '--with-branch'. Previously transformations would ignore each other since they would all take (specification->package SOURCE) as their replacement source, compare it by identity, which doesn't work if a previous transformation has already changed SOURCE. * guix/scripts/build.scm (evaluate-replacement-specs): Adjust to produce an alist as expected by 'package-input-rewriting/spec', with a package spec as the first element of each pair. (evaluate-git-replacement-specs): Likewise. (transform-package-inputs): Adjust accordingly and use 'package-input-rewriting/spec'. (transform-package-inputs/graft): Likewise. (transform-package-source-branch, transform-package-source-commit): Use 'package-input-rewriting/spec'. (transform-package-source-git-url): Likewise, and adjust the REPLACEMENTS alist accordingly. (options->transformation): Iterate over OPTS instead of over %TRANSFORMATIONS. Invoke transformations one by one. * tests/scripts-build.scm ("options->transformation, with-input"): Adjust test to compare packages by name rather than by identity. ("options->transformation, with-git-url + with-branch"): New test. --- doc/guix.texi | 24 ++++++----- guix/scripts/build.scm | 90 +++++++++++++++++++++++------------------ tests/scripts-build.scm | 36 +++++++++++++++-- 3 files changed, 97 insertions(+), 53 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index b0b7ee5dd0..6779ea418e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7721,16 +7721,20 @@ care! @cindex Git, using the latest commit @cindex latest commit, building Build @var{package} from the latest commit of the @code{master} branch of the -Git repository at @var{url}. +Git repository at @var{url}. Git sub-modules of the repository are fetched, +recursively. -For example, the following commands builds the GNU C Library (glibc) straight -from its Git repository instead of building the currently-packaged release: +For example, the following command builds the NumPy Python library against the +latest commit of the master branch of Python itself: @example -guix build glibc \ - --with-git-url=glibc=git://sourceware.org/git/glibc.git +guix build python-numpy \ + --with-git-url=python=https://github.com/python/cpython @end example +This option can also be combined with @code{--with-branch} or +@code{--with-commit} (see below). + @cindex continuous integration Obviously, since it uses the latest commit of the given branch, the result of such a command varies over time. Nevertheless it is a convenient way to @@ -7743,11 +7747,11 @@ consecutive accesses to the same repository. You may want to clean it up once in a while to save disk space. @item --with-branch=@var{package}=@var{branch} -Build @var{package} from the latest commit of @var{branch}. The @code{source} -field of @var{package} must be an origin with the @code{git-fetch} method -(@pxref{origin Reference}) or a @code{git-checkout} object; the repository URL -is taken from that @code{source}. Git sub-modules of the repository are -fetched, recursively. +Build @var{package} from the latest commit of @var{branch}. If the +@code{source} field of @var{package} is an origin with the @code{git-fetch} +method (@pxref{origin Reference}) or a @code{git-checkout} object, the +repository URL is taken from that @code{source}. Otherwise you have to use +@code{--with-git-url} to specify the URL of the Git repository. For instance, the following command builds @code{guile-sqlite3} from the latest commit of its @code{master} branch, and then builds @code{guix} (which diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 7b24cc8eb1..8ebcf79243 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -226,18 +226,21 @@ matching URIs given in SOURCES." obj))))) (define (evaluate-replacement-specs specs proc) - "Parse SPECS, a list of strings like \"guile=guile@2.1\", and invoke PROC on -each package pair specified by SPECS. Return the resulting list. Raise an -error if an element of SPECS uses invalid syntax, or if a package it refers to -could not be found." + "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list +of package spec/procedure pairs as expected by 'package-input-rewriting/spec'. +PROC is called with the package to be replaced and its replacement according +to SPECS. Raise an error if an element of SPECS uses invalid syntax, or if a +package it refers to could not be found." (define not-equal (char-set-complement (char-set #\=))) (map (lambda (spec) (match (string-tokenize spec not-equal) - ((old new) - (proc (specification->package old) - (specification->package new))) + ((spec new) + (cons spec + (let ((new (specification->package new))) + (lambda (old) + (proc old new))))) (x (leave (G_ "invalid replacement specification: ~s~%") spec)))) specs)) @@ -248,8 +251,10 @@ dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of strings like \"guile=guile@2.1\" meaning that, any dependency on a package called \"guile\" must be replaced with a dependency on a version 2.1 of \"guile\"." - (let* ((replacements (evaluate-replacement-specs replacement-specs cons)) - (rewrite (package-input-rewriting replacements))) + (let* ((replacements (evaluate-replacement-specs replacement-specs + (lambda (old new) + new))) + (rewrite (package-input-rewriting/spec replacements))) (lambda (store obj) (if (package? obj) (rewrite obj) @@ -260,13 +265,12 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the current 'gnutls' package, after which version 3.5.4 is grafted onto them." - (define (replacement-pair old new) - (cons old - (package (inherit old) (replacement new)))) + (define (set-replacement old new) + (package (inherit old) (replacement new))) (let* ((replacements (evaluate-replacement-specs replacement-specs - replacement-pair)) - (rewrite (package-input-rewriting replacements))) + set-replacement)) + (rewrite (package-input-rewriting/spec replacements))) (lambda (store obj) (if (package? obj) (rewrite obj) @@ -295,11 +299,13 @@ replacement package. Raise an error if an element of SPECS uses invalid syntax, or if a package it refers to could not be found." (map (lambda (spec) (match (string-tokenize spec %not-equal) - ((name branch-or-commit) - (let* ((old (specification->package name)) - (source (package-source old)) - (url (package-git-url old))) - (cons old (proc old url branch-or-commit)))) + ((spec branch-or-commit) + (define (replace old) + (let* ((source (package-source old)) + (url (package-git-url old))) + (proc old url branch-or-commit))) + + (cons spec replace)) (x (leave (G_ "invalid replacement specification: ~s~%") spec)))) specs)) @@ -318,7 +324,7 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using (let* ((replacements (evaluate-git-replacement-specs replacement-specs replace)) - (rewrite (package-input-rewriting replacements))) + (rewrite (package-input-rewriting/spec replacements))) (lambda (store obj) (if (package? obj) (rewrite obj) @@ -340,7 +346,7 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using (let* ((replacements (evaluate-git-replacement-specs replacement-specs replace)) - (rewrite (package-input-rewriting replacements))) + (rewrite (package-input-rewriting/spec replacements))) (lambda (store obj) (if (package? obj) (rewrite obj) @@ -351,22 +357,20 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of strings like \"guile-json=https://gitthing.com/…\" meaning that packages are built using a checkout of the Git repository at the given URL." - ;; FIXME: Currently this cannot be combined with '--with-branch' or - ;; '--with-commit' because they all transform "from scratch". (define replacements (map (lambda (spec) (match (string-tokenize spec %not-equal) - ((name url) - (let* ((old (specification->package name)) - (new (package - (inherit old) - (source (git-checkout (url url) - (recursive? #t)))))) - (cons old new))))) + ((spec url) + (cons spec + (lambda (old) + (package + (inherit old) + (source (git-checkout (url url) + (recursive? #t))))))))) replacement-specs)) (define rewrite - (package-input-rewriting replacements)) + (package-input-rewriting/spec replacements)) (lambda (store obj) (if (package? obj) @@ -430,16 +434,22 @@ a checkout of the Git repository at the given URL." "Return a procedure that, when passed an object to build (package, derivation, etc.), applies the transformations specified by OPTS." (define applicable - ;; List of applicable transformations as symbol/procedure pairs. + ;; List of applicable transformations as symbol/procedure pairs in the + ;; order in which they appear on the command line. (filter-map (match-lambda - ((key . transform) - (match (filter-map (match-lambda - ((k . arg) - (and (eq? k key) arg))) - opts) - (() #f) - (args (cons key (transform args)))))) - %transformations)) + ((key . value) + (match (any (match-lambda + ((k . proc) + (and (eq? k key) proc))) + %transformations) + (#f + #f) + (transform + ;; XXX: We used to pass TRANSFORM a list of several + ;; arguments, but we now pass only one, assuming that + ;; transform composes well. + (cons key (transform (list value))))))) + (reverse opts))) (lambda (store obj) (fold (match-lambda* diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index 54681274b9..4bf1e1a719 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -139,12 +139,15 @@ (and (not (eq? new p)) (match (package-inputs new) ((("foo" dep1) ("bar" dep2) ("baz" dep3)) - (and (eq? dep1 busybox) - (eq? dep2 findutils) + (and (string=? (package-full-name dep1) + (package-full-name busybox)) + (string=? (package-full-name dep2) + (package-full-name findutils)) (string=? (package-name dep3) "chbouib") (match (package-native-inputs dep3) ((("x" dep)) - (eq? dep findutils))))))))))) + (string=? (package-full-name dep) + (package-full-name findutils)))))))))))) (test-assert "options->transformation, with-graft" (let* ((p (dummy-package "guix.scm" @@ -186,4 +189,31 @@ ((("x" dep3)) (map package-source (list dep1 dep3)))))))))))) +(test-equal "options->transformation, with-git-url + with-branch" + ;; Combine the two options and make sure the 'with-branch' transformation + ;; comes after the 'with-git-url' transformation. + (let ((source (git-checkout (url "https://example.org") + (branch "BRANCH") + (recursive? #t)))) + (list source source)) + (let* ((p (dummy-package "guix.scm" + (inputs `(("foo" ,grep) + ("bar" ,(dummy-package "chbouib" + (native-inputs `(("x" ,grep))))))))) + (t (options->transformation + (reverse '((with-git-url + . "grep=https://example.org") + (with-branch . "grep=BRANCH")))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-name dep1) "grep") + (string=? (package-name dep2) "chbouib") + (match (package-native-inputs dep2) + ((("x" dep3)) + (map package-source (list dep1 dep3)))))))))))) + + (test-end)