aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludovic.courtes@inria.fr>2018-11-30 13:24:48 +0100
committerLudovic Courtès <ludo@gnu.org>2018-11-30 17:03:04 +0100
commitb18f7234aac9eb42097c1b4cda7efe0be5aab132 (patch)
treeb4381cbb251ad72d35096e38a068f3bd4564aa0f
parent96915a448cfe8383a1c47f4b9a1cc810e5161fd0 (diff)
downloadguix-b18f7234aac9eb42097c1b4cda7efe0be5aab132.tar
guix-b18f7234aac9eb42097c1b4cda7efe0be5aab132.tar.gz
guix build: Add '--with-commit'.
* guix/git.scm (<git-checkout>)[commit]: New field. (git-checkout-compiler): Honor it. * guix/scripts/build.scm (evaluate-git-replacement-specs): Add 'proc' parameter and honor it. (transform-package-source-branch)[replace]: New procedure. Adjust 'evaluate-git-replacement-specs' accordingly. (transform-package-source-commit): New procedure. (%transformations, %transformation-options) (show-transformation-options-help): Add 'with-commit'. * tests/guix-build-branch.sh: Add test. * doc/guix.texi (Package Transformation Options): Document it.
-rw-r--r--doc/guix.texi5
-rw-r--r--guix/git.scm11
-rw-r--r--guix/scripts/build.scm60
-rw-r--r--tests/guix-build-branch.sh5
4 files changed, 63 insertions, 18 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 491de5c843..fff5dfe0bf 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6478,6 +6478,11 @@ integration (CI).
Checkouts are kept in a cache under @file{~/.cache/guix/checkouts} to speed up
consecutive accesses to the same repository. You may want to clean it up once
in a while to save disk space.
+
+@item --with-commit=@var{package}=@var{commit}
+This is similar to @code{--with-branch}, except that it builds from
+@var{commit} rather than the tip of a branch. @var{commit} must be a valid
+Git commit SHA1 identifier.
@end table
@node Additional Build Options
diff --git a/guix/git.scm b/guix/git.scm
index 56cebb06ed..f5593ab57c 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -198,12 +198,13 @@ Log progress and checkout info to LOG-PORT."
;;; Checkouts.
;;;
-;; Representation of the "latest" checkout of a branch.
+;; Representation of the "latest" checkout of a branch or a specific commit.
(define-record-type* <git-checkout>
git-checkout make-git-checkout
git-checkout?
(url git-checkout-url)
- (branch git-checkout-branch (default "master")))
+ (branch git-checkout-branch (default "master"))
+ (commit git-checkout-commit (default #f)))
(define latest-repository-commit*
(store-lift latest-repository-commit))
@@ -213,7 +214,9 @@ Log progress and checkout info to LOG-PORT."
;; "Compile" CHECKOUT by updating the local checkout and adding it to the
;; store.
(match checkout
- (($ <git-checkout> url branch)
+ (($ <git-checkout> url branch commit)
(latest-repository-commit* url
- #:ref `(branch . ,branch)
+ #:ref (if commit
+ `(commit . ,commit)
+ `(branch . ,branch))
#:log-port (current-error-port)))))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index e8f2fe973d..5532c65eb6 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -272,16 +272,17 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
(rewrite obj)
obj))))
-(define (evaluate-git-replacement-specs specs)
+(define (evaluate-git-replacement-specs specs proc)
"Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list
-of package pairs. Raise an error if an element of SPECS uses invalid syntax,
-or if a package it refers to could not be found."
+of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the
+replacement package. 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)
- ((name branch)
+ ((name branch-or-commit)
(let* ((old (specification->package name))
(source (package-source old))
(url (cond ((and (origin? source)
@@ -293,11 +294,7 @@ or if a package it refers to could not be found."
(leave (G_ "the source of ~a is not a Git \
reference~%")
(package-full-name old))))))
- (cons old
- (package
- (inherit old)
- (version (string-append "git." branch))
- (source (git-checkout (url url) (branch branch)))))))
+ (cons old (proc old url branch-or-commit))))
(x
(leave (G_ "invalid replacement specification: ~s~%") spec))))
specs))
@@ -307,7 +304,36 @@ reference~%")
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
strings like \"guile-next=stable-3.0\" meaning that packages are built using
'guile-next' from the latest commit on its 'stable-3.0' branch."
- (let* ((replacements (evaluate-git-replacement-specs replacement-specs))
+ (define (replace old url branch)
+ (package
+ (inherit old)
+ (version (string-append "git." branch))
+ (source (git-checkout (url url) (branch branch)))))
+
+ (let* ((replacements (evaluate-git-replacement-specs replacement-specs
+ replace))
+ (rewrite (package-input-rewriting replacements)))
+ (lambda (store obj)
+ (if (package? obj)
+ (rewrite obj)
+ obj))))
+
+(define (transform-package-source-commit replacement-specs)
+ "Return a procedure that, when passed a package, replaces its direct
+dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
+strings like \"guile-next=cabba9e\" meaning that packages are built using
+'guile-next' from commit 'cabba9e'."
+ (define (replace old url commit)
+ (package
+ (inherit old)
+ (version (string-append "git."
+ (if (< (string-length commit) 7)
+ commit
+ (string-take commit 7))))
+ (source (git-checkout (url url) (commit commit)))))
+
+ (let* ((replacements (evaluate-git-replacement-specs replacement-specs
+ replace))
(rewrite (package-input-rewriting replacements)))
(lambda (store obj)
(if (package? obj)
@@ -322,7 +348,8 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
`((with-source . ,transform-package-source)
(with-input . ,transform-package-inputs)
(with-graft . ,transform-package-inputs/graft)
- (with-branch . ,transform-package-source-branch)))
+ (with-branch . ,transform-package-source-branch)
+ (with-commit . ,transform-package-source-commit)))
(define %transformation-options
;; The command-line interface to the above transformations.
@@ -338,7 +365,9 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
(option '("with-graft") #t #f
(parser 'with-graft))
(option '("with-branch") #t #f
- (parser 'with-branch)))))
+ (parser 'with-branch))
+ (option '("with-commit") #t #f
+ (parser 'with-commit)))))
(define (show-transformation-options-help)
(display (G_ "
@@ -350,9 +379,12 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
(display (G_ "
--with-graft=PACKAGE=REPLACEMENT
graft REPLACEMENT on packages that refer to PACKAGE"))
- (display (G_ "
+ (display (G_ "
--with-branch=PACKAGE=BRANCH
- build PACKAGE from the latest commit of BRANCH")))
+ build PACKAGE from the latest commit of BRANCH"))
+ (display (G_ "
+ --with-commit=PACKAGE=COMMIT
+ build PACKAGE from COMMIT")))
(define (options->transformation opts)
diff --git a/tests/guix-build-branch.sh b/tests/guix-build-branch.sh
index bc50d9c0ef..89c1a3cce0 100644
--- a/tests/guix-build-branch.sh
+++ b/tests/guix-build-branch.sh
@@ -46,3 +46,8 @@ orig_drv="`guix build guix -d`"
latest_drv="`guix build guix --with-branch=guile-gcrypt=master -d`"
guix gc -R "$latest_drv" | grep guile-gcrypt-git.master
test "$orig_drv" != "$latest_drv"
+
+v0_1_0_drv="`guix build guix --with-commit=guile-gcrypt=9e3eacdec1d -d`"
+guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-git.9e3eacd
+test "$v0_1_0_drv" != "$latest_drv"
+test "$v0_1_0_drv" != "$orig_drv"