From 880916ac5228b9cfd6e65ac243d17f6bd12edaf9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 12 Mar 2019 15:50:13 +0100 Subject: guix build: Add '--with-git-url'. * guix/scripts/build.scm (%not-equal): New variable. (evaluate-git-replacement-specs): Use it instead of local variable 'not-equal'. (transform-package-source-git-url): New procedure. (%transformations): Add 'with-git-url'. (%transformation-options, show-transformation-options-help): Add '--with-git-url'. * tests/scripts-build.scm ("options->transformation, with-git-url"): New test. --- tests/scripts-build.scm | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) (limited to 'tests/scripts-build.scm') diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index 190426ed06..54681274b9 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2016, 2017, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +23,7 @@ #:use-module (guix scripts build) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix git) #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages busybox) @@ -164,4 +165,25 @@ ((("x" dep)) (eq? (package-replacement dep) findutils))))))))))) +(test-equal "options->transformation, with-git-url" + (let ((source (git-checkout (url "https://example.org") + (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 '((with-git-url . "grep=https://example.org"))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (string=? (package-name dep2) "chbouib") + (match (package-native-inputs dep2) + ((("x" dep3)) + (map package-source (list dep1 dep3)))))))))))) + (test-end) -- cgit v1.2.3 From 14328b81a224b726f39dd030886ba8d332027427 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Mar 2019 10:11:54 +0100 Subject: guix build: Transformation options match packages by spec. 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(-) (limited to 'tests/scripts-build.scm') diff --git a/doc/guix.texi b/doc/guix.texi index 6124c9c24c..a3dd344a70 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7807,16 +7807,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 @@ -7829,11 +7833,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) -- cgit v1.2.3 From 845c44012c2a05436dc0a5316ff3c2a9e5bd725f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Mar 2019 10:26:31 +0100 Subject: guix build: '--with-commit' makes recursive checkouts. This was an omission from commit 024a6bfba906742c136a47b4099f06880f1d3f15. * guix/scripts/build.scm (transform-package-source-commit): Add 'recursive?' field to SOURCE. * tests/scripts-build.scm ("options->transformation, with-branch") ("options->transformation, with-commit"): New tests. --- guix/scripts/build.scm | 3 ++- tests/scripts-build.scm | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 51 insertions(+), 1 deletion(-) (limited to 'tests/scripts-build.scm') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 8ebcf79243..20929d6110 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -342,7 +342,8 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using (if (< (string-length commit) 7) commit (string-take commit 7)))) - (source (git-checkout (url url) (commit commit))))) + (source (git-checkout (url url) (commit commit) + (recursive? #t))))) (let* ((replacements (evaluate-git-replacement-specs replacement-specs replace)) diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index 4bf1e1a719..32876e956a 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -20,6 +20,7 @@ #:use-module (guix tests) #:use-module (guix store) #:use-module (guix packages) + #:use-module (guix git-download) #:use-module (guix scripts build) #:use-module (guix ui) #:use-module (guix utils) @@ -168,6 +169,54 @@ ((("x" dep)) (eq? (package-replacement dep) findutils))))))))))) +(test-equal "options->transformation, with-branch" + (git-checkout (url "https://example.org") + (branch "devel") + (recursive? #t)) + (let* ((p (dummy-package "guix.scm" + (inputs `(("foo" ,grep) + ("bar" ,(dummy-package "chbouib" + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://example.org") + (commit "cabba9e"))) + (sha256 #f))))))))) + (t (options->transformation '((with-branch . "chbouib=devel"))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (string=? (package-name dep2) "chbouib") + (package-source dep2))))))))) + +(test-equal "options->transformation, with-commit" + (git-checkout (url "https://example.org") + (commit "abcdef") + (recursive? #t)) + (let* ((p (dummy-package "guix.scm" + (inputs `(("foo" ,grep) + ("bar" ,(dummy-package "chbouib" + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://example.org") + (commit "cabba9e"))) + (sha256 #f))))))))) + (t (options->transformation '((with-commit . "chbouib=abcdef"))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (string=? (package-name dep2) "chbouib") + (package-source dep2))))))))) + (test-equal "options->transformation, with-git-url" (let ((source (git-checkout (url "https://example.org") (recursive? #t)))) -- cgit v1.2.3