From b18f7234aac9eb42097c1b4cda7efe0be5aab132 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 30 Nov 2018 13:24:48 +0100 Subject: guix build: Add '--with-commit'. * guix/git.scm ()[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. --- doc/guix.texi | 5 ++++ guix/git.scm | 11 +++++---- guix/scripts/build.scm | 60 +++++++++++++++++++++++++++++++++++----------- tests/guix-build-branch.sh | 5 ++++ 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 @@ (define (dot-git? file stat) ;;; 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 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 @@ (define-gexp-compiler (git-checkout-compiler (checkout ) ;; "Compile" CHECKOUT by updating the local checkout and adding it to the ;; store. (match checkout - (($ url branch) + (($ 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 @@ (define (replacement-pair old new) (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 @@ (define not-equal (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 @@ (define (transform-package-source-branch replacement-specs) 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 @@ (define %transformations `((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 @@ (define %transformation-options (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 @@ (define (show-transformation-options-help) (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" -- cgit v1.2.3